{*******************************************************} { } { WHY not a compiler? by Y [05-04-00] } { Why language syntax analysis engine } { } { Copyright (c) 1999-2000 CROWELL, Inc. } { All Rights Reserved. } { } {*******************************************************} unit CSyntax; {$V-} {.$DEFINE DEBUG} interface uses CConstants, CTokenStream, CLists, CCodeGenerator, Dos; var Tokens: PTokenStream; CodeGen: PCodeGenerator; Publics: PHeaderGenerator; GlobalVariables, GlobalConstants, LocalVariables, LocalConstants: PUnsortedStringList; FConsts: PUnsortedFloatList; procedure CompileProgram(SourceName: String); procedure Error(CompilerError: TCompilerError); implementation uses Objects, Strings; var Token: TToken; CurrentIdentifier: String; CurrentType: (ctInteger, ctString); LocalSpace: Integer; {local space, in bytes} CurrentProcedure: String; CurrentFile: String; function StrToLongInt(S: String): LongInt; var Temp: LongInt; Str: String[4]; i: Integer; begin Str := '1234'; for i := 1 to Length(S) do Str[i] := S[i]; {padd with zeros} for i := Length(S) + 1 to 4 do Str[i] := #0; {move to longint} Temp := 0; for i := 4 downto 1 do Temp := Temp shl 8 + Ord(Str[i]); {return} StrToLongInt := Temp; end; {StrToLongInt} { See documentation for Why language grammar. } function CompileImports: Boolean; forward; {Imports} procedure CompileDefinition; forward; {Definition} function CompileGlobalVariableDefinition: Boolean; forward; {GlobalVariableDefinition} function CompileTypeName: Boolean; forward; {TypeName} function CompileVariableDefinition: Boolean; forward; {VariableDefinition} procedure CompileIdentifier; forward; {Identifier} function TryToCompileIdentifier: Boolean; forward; {Identifier} procedure CompileSequence; forward; {Sequence} function CompileElement: Boolean; forward; {Element} function CompileConstant: Boolean; forward; {Constant} function CompileOperation: Boolean; forward; {Operation} function CompileDoubleCharOperation: Boolean; forward; {Operation too} function CompileAsmStatement: Boolean; forward; {AsmStatement} function CompileBeginStatement: Boolean; forward; {BeginStatement} function CompileDoLoopStatement: Boolean; forward; {DoLoopStatement} function CompileDowntoLoopStatement: Boolean; forward; {DowntoLoopStatement} function CompileIfStatement: Boolean; forward; {IfStatement} function CompileInlineStatement: Boolean; forward; {InlineStatement} {function CompileRepeatStatement: Boolean; forward; {RepeatStatement} function CompileToLoopStatement: Boolean; forward; {ToLoopStatement} function CompileProcedureCall: Boolean; forward; {ProcedureCall} function CompileSimpleStatement: Boolean; forward; {SimpleStatement} function CompilePragma: Boolean; forward; {Pragma} function CompileSetting: Boolean; forward; {Setting} procedure CompileEndOfFile; forward; {EndOfFile} procedure Error(CompilerError: TCompilerError); begin Writeln( Tokens^.InputFileName, '(', Token.Line, ',', Token.Position, '): Fatal: ', ErrorMessages[CompilerError]); Halt(256-2); end; {Error} procedure CompileProgram(SourceName: String); {Program} var ExitFlag: Boolean; begin ExitFlag := False; CurrentFile := SourceName; CurrentProcedure := '(global scope)'; CodeGen^.EmitDebugSourceFile(SourceName); CompileImports; with Tokens^ do while not ExitFlag do if ReadDelimiter(Token) then if (Delimiters[Token.I] = ':') then CompileDefinition else begin PutBack(Token); ExitFlag := not CompileGlobalVariableDefinition; end else ExitFlag := not CompileGlobalVariableDefinition; CompileEndOfFile; end; {CompileProgram} function CompileImports: Boolean; {Imports} var Temp: Boolean; begin Temp := False; with Tokens^ do if ReadReservedWord(Token) then if (Token.N = rwImports) then begin while TryToCompileIdentifier do CodeGen^.EmitIncludeDirective(CurrentIdentifier + '.inc'); if ReadDelimiter(Token) then if (Delimiters[Token.I] = ';') then Temp := True else Error(ceSemicolonExpected) else Error(ceSemicolonExpected); end else PutBack(Token); CompileImports := Temp; end; {CompileImports} procedure CompileDefinition; {Definition} begin LocalSpace := 0; LocalVariables^.Clear; {note: ":" is already compiled} CodeGen^.EmitDebugLineNumber(Token.Line); CompileIdentifier; CurrentProcedure := CurrentIdentifier; {generate some code} CodeGen^.StartProcedureDefinition(CurrentIdentifier); CodeGen^.InitLocals(CurrentIdentifier); Publics^.EmitExternalSymbol(CurrentIdentifier, 'NEAR'); CompileSequence; with Tokens^ do if ReadDelimiter(Token) then if (Delimiters[Token.I] = ';') then begin CodeGen^.EmitDebugLineNumber(Token.Line); CodeGen^.EmitIntegerEquate(CurrentProcedure + '_LOCALS', LocalSpace); {generate code for the end of procedure} CodeGen^.DoneLocals; CodeGen^.FinishProcedureDefinition end else Error(ceSemicolonExpected) else Error(ceSemicolonExpected) end; {CompileDefinition} procedure CompileIdentifier; {Identifier} begin with Tokens^ do if ReadReservedWord(Token) then Error(ceIdentifierExpected) else if ReadIdentifier(Token) then if (IsPreDefinedIdentifier(Token.S) = idUnknown) then CurrentIdentifier := Token.S else Error(ceIdentifierExpected) else Error(ceIdentifierExpected); end; {CompileIdentifier} function TryToCompileIdentifier: Boolean; {Identifier} var Temp: Boolean; begin Temp := False; with Tokens^ do if ReadReservedWord(Token) then PutBack(Token) else if ReadIdentifier(Token) then begin CurrentIdentifier := Token.S; Temp := True; end; TryToCompileIdentifier := Temp; end; {TryToCompileIdentifier} procedure CompileSequence; {Sequence} begin while CompileElement do; end; {CompileSequence} function CompileElement; {Element} var Temp: Boolean; begin with Tokens^ do begin Temp := True; if not CompileVariableDefinition then {if not CompileConstantDefinition then} if not CompileDoubleCharOperation then {err...} if not CompileConstant then if not CompileOperation then if not CompileAsmStatement then if not CompileBeginStatement then if not CompileDoLoopStatement then if not CompileDowntoLoopStatement then if not CompileIfStatement then if not CompileInlineStatement then {if not CompileRepeatStatement then} if not CompileSimpleStatement then if not CompileToLoopStatement then if not CompileProcedureCall then Temp := False; end; CompileElement := Temp; end; function CompileDoubleCharOperation: Boolean; {Operation} var Temp: Boolean; procedure PerformSimpleOperation(Operation: SmallString); {"++", ">=", etc} begin CodeGen^.EmitDebugLineNumber(Token.Line); CodeGen^.PerformOperation(Operation); end; {PerformSimpleOperation} procedure PerformComplexOperation(Operation: SmallString); {"<+>" and so on} begin { 1 a <+> 1 a -> + a <- 1 a dup -> rot rot + swap <- } CodeGen^.EmitDebugLineNumber(Token.Line); CodeGen^.EmitDupCode; CodeGen^.PerformOperation('->'); CodeGen^.EmitRotCode; CodeGen^.EmitRotCode; CodeGen^.PerformOperation(Operation); CodeGen^.EmitSwapCode; CodeGen^.PerformOperation('<-'); end; {PerformComplexOperation} procedure PerformUnaryComplexOperation(Operation: SmallString); {"<++>"} begin { a <++> a -> ++ a <- a dup -> ++ swap <- } CodeGen^.EmitDebugLineNumber(Token.Line); CodeGen^.EmitDupCode; CodeGen^.PerformOperation('->'); CodeGen^.PerformOperation(Operation); CodeGen^.EmitSwapCode; CodeGen^.PerformOperation('<-'); end; {PerformUnaryComplexOperation} begin Temp := True; with Tokens^ do {check for unary complex operations} if ReadBigDelimiter(Token, '<++>') then PerformUnaryComplexOperation('++') else if ReadBigDelimiter(Token, '<-->') then PerformUnaryComplexOperation('--') else if ReadBigDelimiter(Token, '<!>') then PerformUnaryComplexOperation('!') else if ReadBigDelimiter(Token, '<~>') then PerformUnaryComplexOperation('~') {check for binary complex operations} else if ReadBigDelimiter(Token, '<+>') then PerformComplexOperation('+') else if ReadBigDelimiter(Token, '<->') then PerformComplexOperation('-') else if ReadBigDelimiter(Token, '<*>') then PerformComplexOperation('*') else if ReadBigDelimiter(Token, '</>') then PerformComplexOperation('/') else if ReadBigDelimiter(Token, '<%>') then PerformComplexOperation('%') {check for simple operations} else if ReadBigDelimiter(Token, '>=') then PerformSimpleOperation('>=') else if ReadBigDelimiter(Token, '<=') then PerformSimpleOperation('<=') else if ReadBigDelimiter(Token, '<>') then PerformSimpleOperation('<>') else if ReadBigDelimiter(Token, '==') then PerformSimpleOperation('==') else if ReadBigDelimiter(Token, '||') then PerformSimpleOperation('||') else if ReadBigDelimiter(Token, '&&') then PerformSimpleOperation('&&') else if ReadBigDelimiter(Token, '<-') then PerformSimpleOperation('<-') else if ReadBigDelimiter(Token, '->') then PerformSimpleOperation('->') else if ReadBigDelimiter(Token, '<.') then PerformSimpleOperation('<.') else if ReadBigDelimiter(Token, '.>') then PerformSimpleOperation('.>') else if ReadBigDelimiter(Token, '[]') then PerformSimpleOperation('[]') else if ReadBigDelimiter(Token, '++') then PerformSimpleOperation('++') else if ReadBigDelimiter(Token, '--') then PerformSimpleOperation('--') else if ReadBigDelimiter(Token, '<<') then PerformSimpleOperation('<<') else if ReadBigDelimiter(Token, '>>') then PerformSimpleOperation('>>') else if ReadBigDelimiter(Token, '!=') then PerformSimpleOperation('!=') else Temp := False; CompileDoubleCharOperation := Temp; end; {CompileDoubleCharOperation} function CompileOperation: Boolean; {Operation} var Temp: Boolean; begin Temp := True; with Tokens^ do if ReadDelimiter(Token) then if (Delimiters[Token.I] in ['+', '-', '/', '*', '%', '|', '&', '~', '!', '<', '>']) then begin CodeGen^.EmitDebugLineNumber(Token.Line); CodeGen^.PerformOperation(Delimiters[Token.I]) end else begin Temp := False; PutBack(Token); end else Temp := False; CompileOperation := Temp; end; {CompileOperation} function CompileAsmStatement: Boolean; {AsmStatement} var Temp, Ok: Boolean; C: Char; Index: Integer; begin Temp := False; with Tokens^ do if ReadReservedWord(Token) then if (Token.N = rwAsm) then begin {emit accurate line debug info} CodeGen^.EmitDebugLineNumber(Token.Line); CodeGen^.SetCacheState(''); {just copy to output assembly source} CodeGen^.EmitComment('asm statement: copying from input file'); CodeGen^.EmitDebugLineNumber(Token.Line); repeat Ok := ReadChar(C); {warning! this will slow things down a bit ;)} if not (C in [CR, LF]) then {TODO: remove "not" ;} CodeGen^.EmitDebugLineNumber(Tokens^.InStream.CurrentLine); if Ok then begin if (C = sAsmEscape) then if ReadChar(C) then begin Index := Pos(C, sAsmEscapeSequences); if (Index <> 0) then C := sAsmEscapeSequences[Index + 1]; CodeGen^.Emit(C); C := sAsmEscape; {not a ";"} end else Error(ceErrorInAsmStatement) else if (C <> ';') then CodeGen^.Emit(C); end; until (C = ';') or (not Ok); if not Ok then Error(ceErrorInAsmStatement) else begin CodeGen^.EmitLine(''); CodeGen^.EmitComment('asm statement finished'); Temp := True; end; end else PutBack(Token); CompileAsmStatement := Temp; end; {CompileAsmStatement} function CompileBeginStatement: Boolean; {BeginStatement} var Temp: Boolean; Label1, Label2: String; CacheState, LastCacheState: String; begin {Assembly code is as follows: ; begin Label1: ... test condition ... if fails JMP Label2 ... sequence 1 ... JMP Label1 Label2: } Temp := False; with Tokens^ do if ReadReservedWord(Token) then if (Token.N = rwBegin) then begin {$IFDEF DEBUG} CodeGen^.EmitComment('begin statement'); {$ENDIF DEBUG} Temp := True; {flush all cache values} CodeGen^.FlushTopCacheValues(cMaxCachedElements); {get two labels} Label1 := CodeGen^.GetNewLabel; Label2 := CodeGen^.GetNewLabel; {code just after 'begin'} CodeGen^.EmitLabel(Label1); CodeGen^.EmitDebugLineNumber(Token.Line); CacheState := CodeGen^.GetCacheState; {calculate condition} CompileSequence; {check for 'while' or 'until' keyword} if ReadReservedWord(Token) then begin if (Token.N = rwWhile) then begin {$IFDEF DEBUG} CodeGen^.EmitComment('while (begin-while-repeat)'); {$ENDIF DEBUG} {start the loop body by checking the condition} LastCacheState := CodeGen^.EmitIfCode(Label2); CompileSequence; {restore the cache state as if after 'begin'} CodeGen^.SetCacheState(CacheState); {check for 'repeat' keyword, perform JMP to 'begin'} if ReadReservedWord(Token) then if (Token.N = rwRepeat) then begin {generate debug info} CodeGen^.EmitDebugLineNumber(Token.Line); CodeGen^.EmitJmp(Label1); end else Error(ceRepeatExpected) else Error(ceRepeatExpected); {set cache state to the one after 'if' code} CodeGen^.SetCacheTo(LastCacheState); CodeGen^.EmitLabel(Label2); end else if (Token.N = rwUntil) then begin {$IFDEF DEBUG} CodeGen^.EmitComment('until (begin-until)'); {$ENDIF DEBUG} {generate accurate debug info} CodeGen^.EmitDebugLineNumber(Token.Line); CodeGen^.EmitUntilCode(Label1, CacheState); Temp := True; end else Error(ceWhileExpected); end else Error(ceWhileExpected); end else PutBack(Token); CompileBeginStatement := Temp; end; {CompileBeginStatement} {New: do-loop statement is added for Forth compatibility} function CompileDoLoopStatement: Boolean; {DoLoopStatement} var Temp: Boolean; Label1, Label2: String; CacheState, LastCacheState: String; begin {Asm code is as follows: ; do code Label1: IF <condition fails> JMP Label2 ; body ... Sequence ... ; loop code JMP Label1 Label2: DROP DROP ; end of do-loop} Temp := False; with Tokens^ do if ReadReservedWord(Token) then if (Token.N = rwDo) then begin Temp := True; {get two labels for start and end of loop} Label1 := CodeGen^.GetNewLabel; Label2 := CodeGen^.GetNewLabel; {start 'do' loop} CodeGen^.EmitDebugLineNumber(Token.Line); CacheState := CodeGen^.EmitDoCode(Label1, Label2); LastCacheState := CodeGen^.GetCacheState; CompileSequence; {check for 'loop' keyword} if ReadReservedWord(Token) then if (Token.N = rwLoop) then begin {generate accurate debug info} CodeGen^.EmitDebugLineNumber(Token.Line); CodeGen^.FlushTopCacheValues(cMaxCachedElements); {undocumented feature ;} CodeGen^.PerformOperation('++'); CodeGen^.EmitLoopCode(Label1, Label2, CacheState); CodeGen^.SetCacheTo(LastCacheState); CodeGen^.EmitDropCode(2); end else Error(ceLoopExpected) else Error(ceLoopExpected); end else PutBack(Token); CompileDoLoopStatement := Temp; end; {CompileDoLoopStatement} function CompileDowntoLoopStatement: Boolean; {DowntoLoopStatement} var Temp: Boolean; Label1, Label2: String; CacheState, LastCacheState: String; begin {Asm code is as follows: ; downto code Label1: IF <condition fails> JMP Label2 ; body ... Sequence ... ; loop code JMP Label1 Label2: DROP DROP ; end of downto-loop} Temp := False; with Tokens^ do if ReadReservedWord(Token) then if (Token.N = rwDownto) then begin Temp := True; {get two labels for start and end of loop} Label1 := CodeGen^.GetNewLabel; Label2 := CodeGen^.GetNewLabel; {start 'downto' loop} CodeGen^.EmitDebugLineNumber(Token.Line); CacheState := CodeGen^.EmitDowntoCode(Label1, Label2); LastCacheState := CodeGen^.GetCacheState; CompileSequence; {check for 'loop' keyword} if ReadReservedWord(Token) then if (Token.N = rwLoop) then begin {generate accurate debug info} CodeGen^.EmitDebugLineNumber(Token.Line); CodeGen^.EmitLoopCode(Label1, Label2, CacheState); CodeGen^.SetCacheTo(LastCacheState); CodeGen^.EmitDropCode(2); end else Error(ceLoopExpected) else Error(ceLoopExpected); end else PutBack(Token); CompileDowntoLoopStatement := Temp; end; {CompileDowntoLoopStatement} function CompileIfStatement: Boolean; {IfStatement} var Temp: Boolean; Label1, Label2: String; CacheState, LastCacheState: String; begin {ASM code is as follows: ... condition ... IF fails JMP Label1 ... sequence 1 ... JMP Label2 Label1: ; else /* optional part */ ... sequence 2 ... ; then Label2: } Temp := False; with Tokens^ do if ReadReservedWord(Token) then if (Token.N = rwIf) then begin CodeGen^.EmitDebugLineNumber(Token.Line); Temp := True; {get two labels} Label1 := CodeGen^.GetNewLabel; Label2 := CodeGen^.GetNewLabel; {start the first block} CacheState := CodeGen^.EmitIfCode(Label1); CompileSequence; {get cache state after 'if' block} CodeGen^.FlushTopCacheValues(cMaxCachedElements); LastCacheState := CodeGen^.GetCacheState; CodeGen^.EmitJmp(Label2); CodeGen^.EmitLabel(Label1); {check for 'then' or 'else' keyword} if ReadReservedWord(Token) then begin CodeGen^.SetCacheTo(CacheState); {else - optional part} if (Token.N) = rwElse then begin {$IFDEF DEBUG} CodeGen^.EmitComment('else part (optional)'); {$ENDIF DEBUG} {generate accurate debug info} CodeGen^.EmitDebugLineNumber(Token.Line); CodeGen^.SetCacheTo(CacheState); CompileSequence; CodeGen^.FlushTopCacheValues(cMaxCachedElements); CodeGen^.FlushTopCacheValues(cMaxCachedElements); end else PutBack(Token); {$IFDEF DEBUG} CodeGen^.EmitComment('else part cache setting'); {$ENDIF DEBUG} {set cache state to LastCacheState even if 'else' missed} CodeGen^.SetCacheState(LastCacheState); {then} if ReadReservedWord(Token) then if (Token.N) = rwThen then begin {$IFDEF DEBUG} CodeGen^.EmitComment('then label'); {$ENDIF DEBUG} {generate accurate debug info} CodeGen^.EmitDebugLineNumber(Token.Line); CodeGen^.EmitLabel(Label2); CodeGen^.SetCacheTo(LastCacheState); { HERE goes the brief explanation of cache stuff ... if // if-then-else <CacheState> ... <LastCacheState> else <CacheState> ... <Unknown cache state> set cache state <LastCacheState> then <LastCacheState> ... ... if // if-then, no else part <CacheState> ... <LastCacheState> // insert here dummy else part and // set cache state to <LastCacheState> then <LastCacheState> ... } {$IFDEF DEBUG} CodeGen^.GetCacheState; {$ENDIF DEBUG} end else Error(ceThenExpected) else Error(ceThenExpected); end else Error(ceThenExpected); end else PutBack(Token); CompileIfStatement := Temp; end; {CompileIfStatement} function CompileInlineStatement: Boolean; {InlineStatement} var Temp: Boolean; begin Temp := False; with Tokens^ do if ReadReservedWord(Token) then if (Token.N = rwInline) then begin {TODO: place things here} CodeGen^.EmitDebugLineNumber(Token.Line); while ReadInteger(Token) do begin CodeGen^.EmitDebugLineNumber(Token.Line); CodeGen^.EmitDataByte(Token.I); end; if ReadDelimiter(Token) then if (Delimiters[Token.I] = ';') then Temp := True else Error(ceSemicolonExpected) else Error(ceSemicolonExpected); end else PutBack(Token); CompileInlineStatement := Temp; end; {CompileInlineStatement} (*function CompileRepeatStatement: Boolean; {RepeatStatement} var Temp: Boolean; Label1: String; CacheState: String; begin Temp := False; with Tokens^ do if ReadReservedWord(Token) then if (Token.N = rwRepeat) then begin CodeGen^.EmitDebugLineNumber(Token.Line); {optimization control} CodeGen^.FlushTopCacheValues(cMaxCachedElements); CacheState := CodeGen^.GetCacheState; Label1 := CodeGen^.GetNewLabel; CodeGen^.EmitLabel(Label1); CompileSequence; {check for 'until' keyword} if ReadReservedWord(Token) then if (Token.N = rwUntil) then begin {generate accurate debug info} CodeGen^.EmitDebugLineNumber(Token.Line); CodeGen^.EmitUntilCode(Label1, CacheState); Temp := True; end else Error(ceUntilExpected) else Error(ceUntilExpected); end else PutBack(Token); CompileRepeatStatement := Temp; end; {CompileRepeatStatement}*) function CompileToLoopStatement: Boolean; {ToLoopStatement} var Temp: Boolean; Label1, Label2: String; CacheState, LastCacheState: String; begin {Asm code is as follows: ; to code Label1: IF <condition fails> JMP Label2 ; body ... Sequence ... ; loop code JMP Label1 Label2: DROP DROP ; end of to-loop} Temp := False; with Tokens^ do if ReadReservedWord(Token) then if (Token.N = rwTo) then begin CodeGen^.EmitDebugLineNumber(Token.Line); Temp := True; {get two labels for start and end of loop} Label1 := CodeGen^.GetNewLabel; Label2 := CodeGen^.GetNewLabel; {start 'to' loop} CacheState := CodeGen^.EmitToCode(Label1, Label2); LastCacheState := CodeGen^.GetCacheState; CompileSequence; {check for 'loop' keyword} if ReadReservedWord(Token) then if (Token.N = rwLoop) then begin {generate accurate debug info} CodeGen^.EmitDebugLineNumber(Token.Line); CodeGen^.EmitLoopCode(Label1, Label2, CacheState); CodeGen^.SetCacheTo(LastCacheState); CodeGen^.EmitDropCode(2); end else Error(ceLoopExpected) else Error(ceLoopExpected); end else PutBack(Token); CompileToLoopStatement := Temp; end; {CompileToLoopStatement} function CompileGlobalVariableDefinition: Boolean; {GlobalVariableDefinition} var Temp: Boolean; VariableName: String; ArraySize: LongInt; begin Temp := False; ArraySize := 0; if CompileTypeName then begin while TryToCompileIdentifier do begin {is it array?} with Tokens^ do if ReadDelimiter(Token) then if (Delimiters[Token.I] = '[') then if ReadInteger(Token) then begin {get array size} ArraySize := Token.I; if (ArraySize <= 0) then Error(ceArraySizeMustBeGreaterThanZero); {match right bracket} if ReadDelimiter(Token) then if Delimiters[Token.I] = ']' then {Ok} else Error(ceRightBracketExpected) else Error(ceRightBracketExpected) end else Error(ceIntegerConstantExpected) else PutBack(Token); CodeGen^.StartProcedureDefinition(CurrentIdentifier); Publics^.EmitExternalSymbol(CurrentIdentifier, 'NEAR'); VariableName := CodeGen^.GetNewVariable; CodeGen^.PushVariablePointerUncached(VariableName); CodeGen^.DataSegment; if (CurrentType = ctInteger) then if (ArraySize < 2) then CodeGen^.EmitDWordVariable(VariableName, 0) else CodeGen^.EmitDWordArray(VariableName, ArraySize) else if (CurrentType = ctString) then if (ArraySize < 2) then CodeGen^.EmitStringVariable(VariableName, '') else CodeGen^.EmitStringArray(VariableName, ArraySize); CodeGen^.CodeSegment; CodeGen^.FinishProcedureDefinition; end; with Tokens^ do if ReadDelimiter(Token) then if (Delimiters[Token.I] = ';') then Temp := True {Ok} else Error(ceSemicolonExpected) else Error(ceSemicolonExpected) end; CompileGlobalVariableDefinition := Temp; end; {CompileGlobalVariableDefinition} function CompileTypeName: Boolean; {TypeName} var Temp: Boolean; begin Temp := False; with Tokens^ do if ReadReservedWord(Token) then if (Token.N = rwInt) then begin Temp := True; CurrentType := ctInteger; end else if (Token.N = rwString) then begin Temp := True; CurrentType := ctString; end else PutBack(Token); CompileTypeName := Temp; end; {CompileTypeName} function CompileVariableDefinition: Boolean; {VariableDefinition} var Temp: Boolean; VariableName: String; ArraySize: Integer; begin Temp := False; ArraySize := 1; if CompileTypeName then begin while TryToCompileIdentifier do begin {is it array?} with Tokens^ do if ReadDelimiter(Token) then if (Delimiters[Token.I] = '[') then if ReadInteger(Token) then begin {get array size} ArraySize := Token.I; if (ArraySize <= 0) then Error(ceArraySizeMustBeGreaterThanZero); {match right bracket} if ReadDelimiter(Token) then if Delimiters[Token.I] = ']' then {Ok} else Error(ceRightBracketExpected) else Error(ceRightBracketExpected) end else Error(ceIntegerConstantExpected) else PutBack(Token); if (CurrentType = ctInteger) or (CurrentType = ctString) then begin LocalVariables^.Add(CurrentIdentifier); LocalSpace := LocalSpace + 4 * ArraySize; CodeGen^.EmitIntegerEquate(CurrentProcedure + '_' + CurrentIdentifier, LocalSpace); {variable or array element is either 32-bit integer value or pointer to ds:string} end; end; with Tokens^ do if ReadDelimiter(Token) then if (Delimiters[Token.I] = ';') then Temp := True {Ok} else Error(ceSemicolonExpected) else Error(ceSemicolonExpected) end; CompileVariableDefinition := Temp; end; {CompileVariableDefinition} function CompileConstant: Boolean; {Constant} var Temp: Boolean; Variable1: String; begin Temp := True; with Tokens^ do {string constant} if ReadString(Token, sStringChars) then begin CodeGen^.EmitDebugLineNumber(Token.Line); CodeGen^.PushStringConstant(Token.S); end {character constant} else if ReadString(Token, sCharacterChars) then begin if (Length(Token.S) > 4) then Error(ceCharacterConstantTooLong); CodeGen^.EmitDebugLineNumber(Token.Line); CodeGen^.PushIntegerConstant(StrToLongInt(Token.S)); end {integer constant} else if ReadInteger(Token) then begin CodeGen^.EmitDebugLineNumber(Token.Line); CodeGen^.PushIntegerConstant(Token.I); end else Temp := False; CompileConstant := Temp; end; {CompileConstant} function CompileProcedureCall: Boolean; {ProcedureCall} var Temp: Boolean; VariableName: String; Index, LineNumber: Integer; function CompilePreDefinedIdentifier: Boolean; {no such rule ;} var Temp: Boolean; Identifier: TPredefinedIdentifier; begin Temp := True; Identifier := IsPreDefinedIdentifier(CurrentIdentifier); case Identifier of idNull: CodeGen^.PushIntegerConstant(0); idFalse: CodeGen^.PushIntegerConstant(0); idTrue: CodeGen^.PushIntegerConstant(1); idsFile: CodeGen^.PushStringConstant(LowerCase(CurrentFile)); idsLine: CodeGen^.PushStringConstant(IntToStr(Token.Line)); idnLine: CodeGen^.PushIntegerConstant(Token.Line); idsName: CodeGen^.PushStringConstant(CurrentProcedure); idsDay, idsMonth, idsYear, idsDate, idsUsDate, idsShortDate, idsShortUsDate, idsWhyDate, idsWhyUsDate, idsTime: CodeGen^.PushStringConstant(DateTimeString(Identifier)); else Temp := False; end; CompilePreDefinedIdentifier := Temp; end; {CompilePreDefinedIdentifier} begin Temp := True; if TryToCompileIdentifier then begin VariableName := CurrentIdentifier; CodeGen^.EmitDebugLineNumber(Token.Line); {is it a local variable?} if (LocalVariables^.Search(@VariableName, Index)) then CodeGen^.PushLocalVariable(CurrentProcedure, VariableName) else {is it pre-defined identifier?} if not CompilePreDefinedIdentifier then {it's either procedure or external variable wrapped with procedure} CodeGen^.Call(CurrentIdentifier); end else Temp := False; CompileProcedureCall := Temp; end; {CompileProcedureCall} function CompileSimpleStatement: Boolean; {SimpleStatement} var Temp: Boolean; begin Temp := True; with Tokens^ do if ReadReservedWord(Token) then if (Token.N = rwDrop) then begin CodeGen^.EmitDebugLineNumber(Token.Line); CodeGen^.EmitDropCode(1); end else if (Token.N = rwDup) then begin CodeGen^.EmitDebugLineNumber(Token.Line); CodeGen^.EmitDupCode; end else if (Token.N = rwRot) then begin CodeGen^.EmitDebugLineNumber(Token.Line); CodeGen^.EmitRotCode; end else if (Token.N = rwSwap) then begin CodeGen^.EmitDebugLineNumber(Token.Line); CodeGen^.EmitSwapCode; end else begin PutBack(Token); Temp := False; end else Temp := False; CompileSimpleStatement := Temp; end; {CompileSimpleStatement} function CompilePragma: Boolean; {Pragma} var Temp: Boolean; begin Temp := False; with Tokens^ do if ReadReservedWord(Token) then if (Token.N = rwPragma) then begin while CompileSetting do; if ReadDelimiter(Token) then if (Delimiters[Token.I] = ';') then Temp := True {ok} else Error(ceSemicolonExpected) else Error(ceSemicolonExpected); end else PutBack(Token); CompilePragma := Temp; end; {CompilePragma} function CompileSetting: Boolean; {Setting} var Temp: Boolean; i: Integer; Identifier: String; begin Temp := True; with Tokens^ do if ReadIdentifier(Token) then begin Identifier := LowerCase(Token.S); if (Identifier = 'setcachestate') then begin if ReadString(Token, sStringChars) then CodeGen^.SetCacheState(ValidCacheString(Token.S)) else Error(ceStringConstantExpected); end else if (Identifier = 'setcacheto') then begin if ReadString(Token, sStringChars) then CodeGen^.SetCacheTo(ValidCacheString(Token.S)) else Error(ceStringConstantExpected); end else begin PutBack(Token); Temp := False; end; end else Temp := False; CompileSetting := Temp; end; {CompileSetting} procedure CompileEndOfFile; {EndOfFile} begin with Tokens^ do if Read(Token) then Error(ceEndOfFileExpected) else if (InStream.Status = 0) then Error(ceEndOfFileExpected); end; {CompileEndOfFile} end {CSyntax}.