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

展开全部

//这是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,@e68a843231313335323631343130323136353331333233666233Result

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

*********************

已赞过

已踩过<

你对这个回答的评价是？

评论

收起