[Kuliah] Listing praktikum 1 - Model Kompilator (pascal)

unit Scanner;
interface

uses winCRT;
const
ALNG = 30; {Number of significant chars in indentifiers.}
eof = #26;
tab = #009;
LineFeed = #010;
space = #032;
car_return = #013;

type
Alfa = string [ALNG];
{Recognized symbol tokens.}
tokens = (
t_int, t_add, t_sub, t_mul, t_rvid, t_double_mul,
t_assign {'='},
t_lbrack {'['}, t_rbrack {']'},
t_lparent {'('}, t_rparent {')'},
t_id, t_else, t_if, t_then
);
const
num_reserved_word = 3; {number of reserved word.}

{recognized reserved word strings.}
KeyStr : array [1.. num_reserved_word] of tokens = (
t_else, t_if, t_then
);

var
FIn : string[12]; {input file name}
Finput : text; {input file pninter}

LookAhead : boolean; {TRUE if had been read ahead, else FALSE}
Enum : boolean; {TRUE if an enumeration delimeter countered}
Ch : char; {Read from input}
token : tokens; {current token}
Id : Alfa; {current identifier}
Inum : longint; {integer number read, must be in --> integer;}
LineNumber : integer;

procedure initialize; {membuka file}
procedure scan;
procedure terminate; {menutup file}

implementation

procedure Initialize;
{initialize variables}
begin
if (ParamCount < 1) then repeat Write ('File Sumber (.pas):'); ReadLn (FIn); until (Length(FIn) <> 0)
else FIn := ParamStr (1);
if (Pos('.', FIn) = 0)
then FIn := FIn + '.pas';
{$I-}
Assign(FInput, FIn);
Reset(FInput);
{$I+}
if (IOResult <>0)
then begin
WriteLn('Tidak bisa mengakses file : ''',FIn,'''');
Halt;
end;

FIn:= Copy(FIn, 1, Pos('.', FIn) -1) + '.out';

LookAhead := FALSE;
Enum := FALSE;
Ch := ' ';
LineNumber :=1;
End;

procedure Terminate;
begin
close (FInput);
end;

procedure GetCh;
{get a charakter from finput}
begin
Read (FInput, Ch);
End;

procedure error_report (id : byte);
begin
case id of
1 : writeln('Error --> unknown charakter"", Ch, ""Line : ', LineNumber);
2 : writeln('Frror --> comment not limited Line', LineNumber);
3 : writeln('Frror --> integer overflo Line', LineNumber);
end;
end;



sumber modul praktikum teori otomata dan kompilasi, gambar http://t1.gstatic.com/images?q=tbn:ANd9GcSKRpuONVd6iKUon_fZ0moHOKU32qypQdOBAhtkcrb4hNlzjbBo6g