www.pudn.com > byyl.rar > PLSCAN.PAS
{ Pass1 : THE PL SCANNER -- PLSCANNER.PAS }
unit plscan;
interface
uses pcommon;
const
MaxChar = 5000;
MaxKey = 631;
MaxInt = 32767;
type
SymbolType = (And1{&}, Array1,arrow1{->},Asterisk1{*}, Becomes1{:=}, Begin1,
Boolean1, Bracket1{[]}, Call1, Comma1{,},Const1, Div1{/}, Do1, End1,
EndText1,Equal1{=}, False1,Fi1,Greater1{>},If1, Integer1, LeftBracket1{[},
LeftParenthesis1{(},Less1{<},Minus1{-}, Mod1{\}, Name1, Newline1,
Not1{~}, Numeral1,od1, Or1{|},Period1{.},Plus1{+},Proc1,Read1,
RightBracket1{]},RightParenthesis1{)},Semicolon1{;},skip1,
True1,Unknown1,Write1); //°´×Öĸ˳ÐòÅÅÁÐ
procedure Pass1;
implementation
procedure Pass1;
const
ETX = chr(3);
NL = chr(10);
SP = chr(32);
Dollor = chr(36);
LastStandardName = Write1;
type
CharSet = set of char;
SpellingTable = array [1..MaxChar] of char;
WordPointer = ^ WordRecord;
WordRecord = record
NextWord: WordPointer;
IsName: Boolean;
Index, Length, LastChar: integer
end;
HashTable = array [1..MaxKey] of WordPointer;
var
AlphaNumeric, Digits,
EndComment, Invisible,
Letters, Separators,
SmallLetters,CapitalLetters : CharSet;
ch: char;
Characters: integer;
Spelling: SpellingTable;
Hash: HashTable; Names: integer;
{ OUTPUT }
procedure Emit1(Symbol: SymbolType);
begin
Emit(ord(Symbol))
end;
procedure Emit2(Symbol: SymbolType; Argument: integer);
begin
Emit(ord(Symbol));
Emit(Argument)
end;
{ PROCESSING EOLN }
procedure BeginLine(Number: integer);
begin
LineNo := Number;
NewLine(LineNo);
Emit2(NewLine1, LineNo)
end;
procedure EndLine;
begin
BeginLine(LineNo + 1)
end;
{ INPUT }
procedure NextChar;
begin
if EOF(Input1) then ch := ETX
else
if EOLN(Input1) then
begin
ch := NL;
Readln(Input1)
end
else
begin
Read(Input1, ch);
if ch in Invisible then
NextChar
end
end;
{ WORD SYMBOLS AND NAMES }
function Key(Text1: String; Length: integer): integer;
const
W = 32641 { 32768 - 127 };
N = MaxKey;
var
Sum, i: integer;
begin
Sum := 0;
for i := 1 to Length do
Sum := (Sum + ord(Text1[i])) mod W;
Key := Sum mod N + 1
end;
procedure Insert(IsName: Boolean; Text1: String;
Length,Index,KeyNo: integer);
var
Pointer: WordPointer;
M, N: integer;
begin { Insert the word in the spelling table }
N := Characters;
Characters := Characters + Length;
TestLimit(Characters, MaxChar);
for M := 1 to Length do
Spelling[N + M] := Text1[M];
{ Insert the word in a word list }
New(Pointer);
Pointer^.NextWord := Hash[KeyNo];
Pointer^.IsName := IsName;
Pointer^.Index := Index;
Pointer^.Length := Length;
Pointer^.LastChar := Characters;
Hash[KeyNo] := Pointer
end;
function Found(Text1: String; Length: integer;
Pointer: WordPointer): Boolean;
var
Same: Boolean;
M, N: integer;
begin
if Pointer^.Length <> Length then
Same := false
else
begin
Same := true;
M := Length;
N := Pointer^.LastChar - M;
while Same and (M > 0) do
begin
Same := Text1[M] = Spelling[M + N];
M := M -1
end
end;
Found := Same
end;
procedure Define(IsName: Boolean; Text1: String;
Length, Index: integer);
begin
Insert(IsName, Text1, Length, Index, Key(Text1, Length))
end;
procedure Search(Text1: String; Length: integer;
var Isname: Boolean;var Index: integer);
var
KeyNo: integer; Pointer: WordPointer; Done: Boolean;
begin
KeyNo := Key(Text1, Length);
Pointer := Hash[KeyNo];
Done := false;
while not Done do
if Pointer = nil then
begin
IsName := true;
Names := Names + 1; Index := Names;
Insert(true, Text1, Length, Index, KeyNo);
Done := True
end
else
if Found(Text1, Length, Pointer) then
begin
IsName := Pointer^.IsName;
Index := Pointer^.Index;
Done := true
end
else
Pointer := Pointer^.NextWord
end;
procedure Initialize;
var
KeyNo: integer;
begin
Digits := ['0'..'9'];
CapitalLetters := ['A'..'Z'];
SmallLetters := ['a'..'z'];
Letters := CapitalLetters + SmallLetters;
AlphaNumeric := Letters + Digits + ['_'];
EndComment := [ETX];
Invisible := [chr(0)..chr(31), chr(127)] - [NL, ETX];
Separators := [SP, NL, Dollor];
Characters := 0;
for KeyNo := 1 to MaxKey do Hash[KeyNo] := nil;
{ Insert the word symbols }
Define(false,'array',5,ord(Array1));
Define(false,'begin',5,ord(Begin1));
Define(false,'call',4,ord(call1));
Define(false,'const',5,ord(Const1));
Define(false,'do',2,ord(Do1));
Define(false,'end',3,ord(End1));
Define(false,'fi',2,ord(fi1));
Define(false,'if',2,ord(If1));
Define(false,'od',2,ord(od1));
Define(false,'proc',4,ord(Proc1));
Define(false,'skip',4,ord(skip1));
{ Insert the standard names }
Define(false,'integer',7,ord(Integer1));
Define(false,'boolean',7,ord(Boolean1));
Define(false,'false',5,ord(False1));
Define(false,'true',4,ord(True1));
Define(false,'read',4,ord(Read1));
Define(false,'write',5,ord(Write1));
// define(true,'writeln',7,writeln0);
Names := ord(LastStandardName);
end;
{ LEXICAL ANALYSIS }
procedure Comment;
begin {ch = Dollor}
NextChar;
while not ((ch = NL )or(ch = ETX)) do NextChar;
if ch = NL then
begin
EndLine;
NextChar
end;
end;
procedure NextSymbol;
var
IsName: Boolean; Text1: String;
Length, Index, Value, Digit: integer;
begin
while ch in Separators do
if ch = SP then NextChar
else
if ch = NL then
begin
EndLine;
NextChar
end
else {ch = Dollor} Comment;
if ch in Letters then
begin
Length := 0; Text1 := '';
while ch in AlphaNumeric do
begin
// if ch in CapitalLetters then
// ch := chr(ord(ch) + ord('a') - ord('A'));
Length := Length + 1;
Text1 := Text1 + ch;
NextChar
end;
Search(Text1, Length, IsName, Index);
if IsName then Emit2(Name1, Index)
else Emit(Index);
end
else
if ch in Digits then
begin
Value := 0;
while ch in Digits do
begin
Digit := ord(ch) - ord('0');
if Value <= (MaxInt - Digit) div 10 then
begin
Value := 10 * Value + Digit;
NextChar
end
else
Begin
Error(Numeral3);
while ch in Digits do
NextChar
end
end;
Emit2(Numeral1, Value)
end
else
case ch of
'+': begin
Emit1(Plus1);
NextChar
end;
'-': begin
Nextchar;
if ch = '>' then
begin
Emit1(Arrow1);
NextChar
end
else Emit1(Minus1);
end;
'*': begin
Emit1(Asterisk1);
NextChar
end;
'<': begin
Emit1(Less1);
Nextchar;
end;
'=': begin
Emit1(Equal1);
NextChar
end;
'>': begin
Emit1(Greater1);
Nextchar;
end;
':': begin
Nextchar;
if ch = '=' then
begin
Emit1(Becomes1);
NextChar
end
else
Error(Ambiguous3)
end;
'(': begin
Emit1(LeftParenthesis1);
NextChar
end;
')': begin
Emit1(rightParenthesis1);
NextChar
end;
'[': begin
Nextchar;
if ch = ']' then
begin
Emit1(Bracket1);
NextChar
end
else Emit1(LeftBracket1);
end;
']': begin
Emit1(RightBracket1);
NextChar
end;
',': begin
Emit1(Comma1);
NextChar
end;
'.': begin
Emit1(Period1);
Nextchar;
end;
';': begin
Emit1(Semicolon1);
NextChar
end;
'&': begin
Emit1(And1);
NextChar
end;
'|': begin
Emit1(Or1);
NextChar
end;
'~': begin
Emit1(Not1);
NextChar
end;
'/': begin
Emit1(Div1);
NextChar
end;
'\': begin
Emit1(Mod1);
NextChar
end;
else
if ch <> ETX then
begin
Emit1(Unknown1);
NextChar
end
end { case }
end;
{ Pass1 : THE PL SCANNER }
begin
Initialize;
BeginLine(1);
NextChar;
while ch <> ETX do
NextSymbol;
Emit1(EndText1)
end;
end.