高分急求类pascal编译器的源代码（用lex和yacc做的，能够运行成功的 ）

Question

最好有简单的说明
实现语言的基本说明语句和简单赋值语句及算术运算表达式语法分析即可
（词法分析部分包括标识符、数字构成规则等部分）；
lex yacc编程工具：parser generator
在 windows能和vc++连接
我的邮箱 [email protected]

Answer 1

pascal 是虾米哟~~~??

Answer 2

//这是Trubo Pascal7.0的编译器程序
Program WinPascal;

{$X+}
uses Globals, Gen_Code, Errors;

Procedure GetChar;
begin
if Not Eof(Source) then Read(Source,Look)
else Look := '.';

If Look = #13 then Inc(LineCount);
end;

procedure SkipSpace;
begin
While (look in [Cr,Lf,Tab_,' ']) AND (Not Eof(Source)) do
GetChar;
end;

Procedure Parse_Directive;
begin
if Look in ['C','c'] then
Console_App := True;
if Look in ['G','g'] then
Gui_App := True;
end;

Procedure GetToken;
label
restart;
var
i,j : word;
x : boolean;
last: char;
begin
RESTART:
Current_String := '';
Current_Token := _Unknown;
Current_Number := 0;
SkipSpace;
Case Look of
'{' : begin
GetChar;
if Look = '$' then
begin
GetChar;
Parse_Directive;
end;

repeat
GetChar;
until Look = '}';
GetChar;
Goto Restart;
end;

'(' : begin
getchar;
if look = '*' then
begin
getchar;
repeat
last := look;
getchar;
until (last = '*') and (look = ')');
getchar;

Goto Restart;
end
else
current_token := _lparen;
end;

'''' : begin
getchar;
current_string := '';
x := false;
repeat
case look of
cr : abort('String exceeds line');
'''' : begin
getchar;
if look <> '''' then
x := true
else
current_string := current_string + look;
end;
else
current_string := current_string + look;
getchar;
end;
until x;
current_token := _string_constant;
end;

'$' : begin
GetChar;
While (UpCase(Look) in ['0'..'9','A'..'F']) do
begin
Current_Number := Current_Number SHL 4 +
Pos(UpCase(Look),HexCode)-1;
GetChar;
end;
Current_Token := _numeric_constant;
end;
'0'..'9' : begin
while look in ['0'..'9'] do
begin
Current_Number := Current_Number * 10 +
Pos(Look,HexCode)-1;
GetChar;
end;
current_token := _numeric_constant;
end;
'_','A'..'Z',
'a'..'z' : begin
While UpCase(Look) in ['_','0'..'9',
'A'..'Z',
'a'..'z' ] do
begin
Current_String := Current_String + UpCase(Look);
GetChar;
for i := 0 to MaxToken do
if Current_String = TokenName[i] then
begin
Current_Token := Token(i);
end;
end;
If Current_Token = _Unknown then
Current_Token := _name;
end;
else
Current_String := UpCase(Look); GetChar;
Repeat
J := 0;
For i := 0 to MaxToken do
if (Current_string+UpCase(Look)) = TokenName[i] then
J := i;
If J <> 0 then
begin
Current_String := Current_String + UpCase(Look);
GetChar;
end;
Until J = 0;

For i := 0 to MaxToken do
if Current_String = TokenName[i] then
J := i;
Current_Token := Token(j);
end; { Case Look }

end;

function ToUpper(S : String):String;
begin
asm
cld
lea si,S
les di,@Result
SEGSS lodsb
stosb
xor ah,ah
xchg ax,cx
jcxz @3
@1:
SEGSS lodsb
cmp al,'a'
ja @2
cmp al,'z'
jb @2
sub al,20H
@2:
stosb
loop @1
@3:
end;
end;

function GetName:String;
begin
if Current_Token = _Name then
GetName := '_' + ToUpper(Current_String)
else
Expected('Name');

GetToken;
end;

function GetNumber:Integer;
begin
GetNumber := Current_Number;
GetToken;
end;

Procedure AddSymbol(_Name : String; _Kind : Integer);
var i : integer;
Duplicate : boolean;
Begin
for i := 0 to SymbolCount do
if SymbolTable[i].Name = ToUpper(_Name) then
begin
Duplicate := True;
Abort('Duplicate identifier '+ Copy(_Name,2,Length(_Name)-1));
end;

for i := 0 to ProcCount do
if ProcTable[i].Name = ToUpper(_Name) then
begin
Duplicate := True;
Abort('Duplicate identifier '+ Copy(_Name,2,Length(_Name)-1));
end;

if Duplicate = false then
begin
SymbolTable[SymbolCount].Name := _Name;
SymbolTable[SymbolCount].Kind := _Kind;
Inc(SymbolCount);
end;
End;

Procedure DumpSymbols;
var
i, x : integer;
Begin
WriteLn(Dest);
WriteLn(Dest,TAB,'.data');

for i := 0 to SymbolCount - 1 do
case TypeTable[SymbolTable[i].Kind].Size of
1,2,4 : WriteLn(Dest,TAB,SymbolTable[i].Name,' ','DB',TAB,
TypeTable[SymbolTable[i].Kind].Size,TAB,'DUP (?)');
end;

WriteLn(Dest,TAB,'.code');
End;

Function LookType(_Name : String):Integer;
{ True if _NAME is in table }
Var
q,r : Integer;
Begin
r := -1;
For q := 0 to TypeCount-1 do
If TypeTable[q].Name = _Name then
r := q;
LookType := r;
End;

Procedure CheckType(_Name : String);
Begin
If (LookType(_Name) = -1) then
Expected('type');
End;

(* Function DoStringConst(S : String):String;
Begin
StringConst[StringCount] := S;
DoStringConst := '_STR'+Numb(StringCount);
Inc(StringCount);
End; *)

(**********************
Parsing Routines
*********************