home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
pascal
/
interpre
/
pl
/
scanner.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1986-12-12
|
32KB
|
826 lines
PROGRAM PL_SCANNER;
{*****************************************************************************}
{*****************************************************************************}
{**** PROGRAM: PL_SCANNER - SCANS A TEXT FILE OF A PL PROGRAM AND ****}
{**** CONVERTS IT INTO CODE THE PL PARSER CAN UNDERSTAND... ****}
{-----------------------------------------------------------------------------}
{**** AUTHOR: JAY MONFORT FOR: MATH 434 - COMPILER DESIGN ****}
{**** SEPTEMBER 25, 1985 ****}
{*****************************************************************************}
{*****************************************************************************}
{-----------------------------------------------------------------------------}
{$C-,K-,V-,D-}
{ NO CTRL-C CHECK, NO STACK CHECK, NO VAR LENGTH CHECK, NO DEVICE CHECK }
{-----------------------------------------------------------------------------}
CONST
MAXINT = 32767;
MAXKEY = 107; { LENGTH OF HASHTABLE }
MAXCHARS = 1000; { LENGTH OF SPELLING TABLE }
MAXSTRING = 80; { MAXIMUM STRING LENGTH }
{=============================================================================}
TYPE
SYMBOL_TYPE =
(AND1,ARRAY1,ARROW1,BECOMES1,BEGIN1,{ 5 }BOOLEAN1,CALL1,COMMA1,CONST1,
DIV1,{ 10 }DO1,END1,ENDTEXT1,EQUAL1,FALSE1,{ 15 }FI1,GREATER1,IF1,
INTEGER1,LEFT_BRACKET1,{ 20 }LEFT_PAREN1,LESS1,MINUS1,MOD1,MULT1,
{ 25 }NAME1,NEWLINE1,NOT1,NUMERAL1,OD1,{ 30 }OR1,PAIRED_BRACKETS1,
PERIOD1,PLUS1,PROC1,{ 35 }READ1,RIGHT_BRACKET1,RIGHT_PAREN1,
SEMICOLON1,SKIP1,{ 40 }TRUE1,UNKNOWN1,WRITE1);
ERROR_TYPE = (NUMERAL3,UNKNOWN3,TOOBIG3);
CHARSET = SET OF CHAR;
WORD_POINTER = ^WORD_RECORD;
WORD_RECORD = RECORD
NEXT_WORD: WORD_POINTER; { POINTS TO NEXT WORD IN CHAIN }
ISNAME: BOOLEAN; { NAME ELSE SYMBOL }
INDEX, { ORD(NAME) OR ORD(SYMBOL) }
STRLENGTH, { CHAR LENGTH IF NAME }
LASTCHAR: INTEGER { INDX LAST CHAR IN SPELL TABLE }
END;
WRKSTRING = STRING[MAXSTRING];
HASHTABLETYPE = ARRAY[1..MAXKEY] OF WORD_POINTER;
SPELLINGTABLETYPE = ARRAY[1..MAXCHARS] OF CHAR;
{=============================================================================}
VAR
SEPARATORS,LETTERS, ALPHANUMERIC,
DIGITS, INVISIBLE, ASCII, SPECIAL: CHARSET; { USEFUL CHARACTER SETS }
TOTALCHARS, { TOTAL NUMBER OF CHARACTERS IN SPELLING TABLE }
LINENUM, { CURRENT SOURCE LINE NUMBER DURING SCAN }
NAMES: INTEGER; { NUMBER OF DEFINED NAMES }
HASHTABLE: HASHTABLETYPE; { FOR WORD SYMBOLS, USING DIRECT CHAINING }
SPELLTABLE: SPELLINGTABLETYPE; { TABLE OF WORDS, ACCESSED THRU HASHTABLE }
SOURCEFILE, { THE SOURCE CODE }
{ BOTH WITH 10K BUFFERS }
CODEFILE: TEXT[$2800]; { THE OUTPUT CODE FILE }
ERRFILE: TEXT[$800]; { THE ERROR MESSAGE FILE, WITH 2K BUFFER }
CH: CHAR; { THE CURRENT CHARACTER }
ERROPENED: BOOLEAN; { TELLS IF ERROR FILE IS OPENED }
{=============================================================================}
{*****************************************************************************}
{**** FUNCTION EXIST - RETURNS TRUE IF A FILE IS ON DISK ****}
{*****************************************************************************}
FUNCTION EXIST(FILENAME: WRKSTRING): BOOLEAN;
VAR
FIL: FILE;
BEGIN
ASSIGN(FIL,FILENAME);
{$I-}
RESET(FIL);
{$I+}
EXIST:= (IORESULT = 0);
IF IORESULT = 0
THEN CLOSE(FIL)
END; { FUNCTION EXIST }
{*****************************************************************************}
{=============================================================================}
{=============================================================================}
{==== THE FOLLOWING PROCEDURES OPEN THE INPUT AND OUTPUT FILES ====}
{==== ====}
{*****************************************************************************}
{**** PROCEDURE OPEN_SOURCE - OPENS THE SOURCE CODE FILE ****}
{*****************************************************************************}
PROCEDURE OPEN_SOURCE;
VAR
SOURCECODE: WRKSTRING;
{ GLOBAL VARIABLE - SOURCEFILE: TEXT }
BEGIN
IF PARAMCOUNT = 0
THEN
BEGIN
LOWVIDEO;
WRITE('ENTER THE SOURCE CODE FILENAME: ');
NORMVIDEO;
READLN(SOURCECODE)
END
ELSE SOURCECODE:= PARAMSTR(1);
IF EXIST(SOURCECODE)
THEN
BEGIN
ASSIGN(SOURCEFILE,SOURCECODE);
RESET(SOURCEFILE);
GOTOXY(20,8);
LOWVIDEO;
WRITE('SCANNING ');
NORMVIDEO;
WRITE(SOURCECODE)
END
ELSE
BEGIN
WRITELN;
WRITELN('UNKNOWN DISK ERROR OR ',SOURCECODE,' NOT FOUND.');
HALT(100) { USED FOR ERRORLEVEL IN BATCH FILE }
END
END; { PROCEDURE OPEN_SOURCE }
{*****************************************************************************}
{*****************************************************************************}
{**** PROCEDURE OPEN_CODE - OPENS THE CODE FILE FOR OUTPUT ****}
{*****************************************************************************}
PROCEDURE OPEN_CODE;
{ GLOBAL VARIABLE - CODEFILE: TEXT }
BEGIN
ASSIGN(CODEFILE,'TEMP1.');
{$I-}
REWRITE(CODEFILE);
{$I+}
IF IORESULT <> 0
THEN
BEGIN
WRITELN;
WRITELN('UNKNOWN DISK ERROR');
HALT(100) { PICKED UP AS ERRORLEVEL BY DOS }
END
END;
{*****************************************************************************}
{==== END OF FILE OPENING PROCEDURES ====}
{=============================================================================}
{=============================================================================}
{=============================================================================}
{=============================================================================}
{==== THE FOLLOWING ARE THE ERROR HANDLING PROCEDURES ====}
{==== FOR WRITING TO THE ERROR FILE... ====}
{*****************************************************************************}
{**** PROCEDURE OPENERROR - OPENS THE ERROR FILE ****}
{*****************************************************************************}
PROCEDURE OPENERROR(FILENAME: WRKSTRING);
{ GLOBAL VARIABLE - ERRFILE: TEXT }
BEGIN
ASSIGN(ERRFILE,FILENAME);
{$I-}
REWRITE(ERRFILE);
{$I+}
IF IORESULT <> 0
THEN
BEGIN
WRITELN('UNKNOWN DISK ERROR');
HALT(100)
END
END; { PROCEDURE OPENERROR }
{*****************************************************************************}
{*****************************************************************************}
{**** PROCEDURE TIMESTR - WRITES THE CURRENT TIME TO THE ERROR FILE ****}
{*****************************************************************************}
PROCEDURE TIMESTR;
{ GLOBAL VARIABLE - ERRFILE: TEXT }
TYPE
REGPACK = RECORD
AX,BX,CX,DX,BP,SI,DI,DS,ES,FLAGS: INTEGER
END;
VAR
REGS: REGPACK;
HOURS,MINS,SECS,FRACS: INTEGER;
HRSTR,MNSTR,SCSTR,FRACSTR: STRING[2];
BEGIN
WITH REGS DO
BEGIN
AX:= $2C00; {DOS INT 21H, FUNCTION 2C(H)}
MSDOS(REGS);
HOURS:= HI(CX); {HI ORDER BYTE OF CX}
MINS:= LO(CX); {LOW ORDER BYTE OF CX}
SECS:= HI(DX);
FRACS:= LO(DX)
END;
STR(HOURS:2,HRSTR);
STR(MINS:2,MNSTR);
STR(SECS:2,SCSTR);
STR(FRACS:2,FRACSTR);
IF MINS = 0
THEN MNSTR:= '00'
ELSE IF MINS < 10
THEN MNSTR[1]:= '0';
IF SECS = 0
THEN SCSTR:= '00'
ELSE IF SECS < 10
THEN SCSTR[1]:= '0';
IF FRACS = 0
THEN FRACSTR:= '00'
ELSE IF FRACS < 10
THEN FRACSTR[1]:= '0';
WRITE(ERRFILE,'-- ',HRSTR ,':',MNSTR,':',SCSTR,'.',FRACSTR,' --> ')
END; { PROCEDURE TIMESTR }
{*****************************************************************************}
{*****************************************************************************}
{**** PROCEDURE ERROR - HANDLES THE SCANNER ERRORS ****}
{*****************************************************************************}
PROCEDURE ERROR(ERRTYPE: ERROR_TYPE);
{ GLOBAL VARIABLE - ERRFILE: TEXT }
BEGIN
IF NOT ERROPENED
THEN
BEGIN
ERROPENED:= TRUE;
OPENERROR('ERROR1.');
END;
TIMESTR;
CASE ERRTYPE OF
NUMERAL3: WRITE(ERRFILE,'INTEGER OUT OF RANGE ');
UNKNOWN3: WRITE(ERRFILE,'UNKNOWN SYMBOL ');
TOOBIG3 : WRITE(ERRFILE,'SPELLING TABLE OVERFLOW ')
END; { CASE }
WRITELN(ERRFILE,'AT LINE ',LINENUM:5)
END; { PROCEDURE ERROR }
{*****************************************************************************}
{==== ====}
{==== END OF ERROR HANDLING PROCEDURES ====}
{=============================================================================}
{=============================================================================}
{=============================================================================}
{=============================================================================}
{==== THE FOLLOWING ARE THE WORD SYMBOL PROCEDURES AND FUNCTIONS ====}
{==== FOR THE HASH AND SPELLING TABLES ====}
{*****************************************************************************}
{*** FUNCTION HASH - HASHES A NAME INTO A KEY NUMBER ***}
{*****************************************************************************}
FUNCTION HASH(VAR TEXTSTRING: WRKSTRING; WORD_LENGTH: INTEGER): INTEGER;
CONST
BIG = 32513;
HASHSIZE = MAXKEY; { MAXKEY IS GLOBAL CONSTANT }
VAR
SUM, I: INTEGER;
BEGIN
SUM:= 0;
I:= 1;
WHILE I <= WORD_LENGTH DO
BEGIN
SUM:= (SUM + ORD(TEXTSTRING[I])) MOD BIG;
I:= I + 1
END;
HASH:= (SUM MOD HASHSIZE) + 1
END; { FUNCTION HASH }
{*****************************************************************************}
{*****************************************************************************}
{**** FUNCTION FITS - MAKES SURE A STRING WILL FIT IN THE SPELLING TABLE ****}
{*****************************************************************************}
FUNCTION FITS(WORD_LENGTH: INTEGER): BOOLEAN;
{ GLOBAL CONSTANT - MAXCHARS }
{ GLOBAL VARIABLE - TOTALCHARS: INTEGER }
BEGIN
IF (TOTALCHARS + WORD_LENGTH) <= MAXCHARS
THEN FITS:= TRUE
ELSE
BEGIN
ERROR(TOOBIG3);
FITS:= FALSE
END
END; { FUNCTION FITS }
{*****************************************************************************}
{*****************************************************************************}
{** PROCEDURE INSERTWORD - INSERTS A WORD INTO THE SPELLING AND HASH TABLES **}
{*****************************************************************************}
PROCEDURE INSERTWORD( ISNAME: BOOLEAN; VAR TEXTSTR: WRKSTRING;
INDEX, WORD_LENGTH, KEYNUM: INTEGER);
{ GLOBAL VARIABLES - TOTALCHARS: INTEGER; HASHTABLE: HASHTABLETYPE }
VAR
POINTER: WORD_POINTER;
M, N, I: INTEGER;
BEGIN
IF FITS(WORD_LENGTH)
THEN
BEGIN
TOTALCHARS:= TOTALCHARS + WORD_LENGTH;
M:= WORD_LENGTH;
N:= TOTALCHARS - M;
FOR I:= M DOWNTO 1 DO
SPELLTABLE[I + N]:= TEXTSTR[I];
NEW(POINTER);
POINTER^.NEXT_WORD:= HASHTABLE[KEYNUM];
POINTER^.ISNAME:= ISNAME;
POINTER^.INDEX:= INDEX;
POINTER^.STRLENGTH:= WORD_LENGTH;
POINTER^.LASTCHAR:= TOTALCHARS;
HASHTABLE[KEYNUM]:= POINTER
END { IF FITS }
END; { PROCEDURE INSERT }
{*****************************************************************************}
{*****************************************************************************}
{* PROCEDURE DEFINE - USED TO INITIALIZE WORD SYMBOLS TO THE SPELLING TABLE *}
{*****************************************************************************}
PROCEDURE DEFINE(ISNAME: BOOLEAN; TEXTSTR: WRKSTRING;
INDEX, WORD_LENGTH: INTEGER);
BEGIN
INSERTWORD(ISNAME,TEXTSTR,INDEX,WORD_LENGTH,HASH(TEXTSTR,WORD_LENGTH))
END; { PROCEDURE DEFINE }
{*****************************************************************************}
{*****************************************************************************}
{*PROCEDURE SEARCH-LOOK TO SEE IF A NAME OR WORDSYMBOL WAS DEFINED PREVIOUSLY*}
{*****************************************************************************}
PROCEDURE SEARCH(VAR TEXTSTR: WRKSTRING; VAR ISNAME: BOOLEAN;
VAR INDEX: INTEGER; WORD_LENGTH: INTEGER);
{ GLOBAL VARIABLE - HASHTABLE: HASHTABLETYPE }
VAR
KEYNUM: INTEGER;
POINTER: WORD_POINTER;
DONE: BOOLEAN;
{-----------------------------------------------------------------------------}
{--- FUNCTION FOUND - LOOKS TO SEE IF THE CURRENT CHARS ARE THE RIGHT ONES ---}
{-----------------------------------------------------------------------------}
FUNCTION FOUND: BOOLEAN;
{ GLOBAL VARIABLE - SPELLTABLE: SPELLTABLETYPE }
VAR
SAME: BOOLEAN;
M, N: INTEGER;
BEGIN
IF POINTER^.STRLENGTH <> WORD_LENGTH
THEN SAME:= FALSE
ELSE
BEGIN
SAME:= TRUE;
M:= WORD_LENGTH;
N:= POINTER^.LASTCHAR - M;
WHILE SAME AND (M > 0) DO
BEGIN
SAME:= (TEXTSTR[M] = SPELLTABLE[M+N]);
M:= M - 1
END
END;
FOUND:= SAME
END; { FUNCTION FOUND }
{-----------------------------------------------------------------------------}
BEGIN { PROCEDURE SEARCH }
KEYNUM:= HASH(TEXTSTR,WORD_LENGTH);
POINTER:= HASHTABLE[KEYNUM];
DONE:= FALSE;
WHILE NOT DONE DO
IF POINTER = NIL
THEN
BEGIN
ISNAME:= TRUE;
NAMES:= NAMES + 1;
INDEX:= NAMES;
INSERTWORD(TRUE,TEXTSTR,INDEX,WORD_LENGTH,KEYNUM);
DONE:= TRUE
END
ELSE
IF FOUND
THEN
BEGIN
ISNAME:= POINTER^.ISNAME;
INDEX:= POINTER^.INDEX;
DONE:= TRUE
END
ELSE POINTER:= POINTER^.NEXT_WORD
END; { PROCEDURE SEARCH }
{*****************************************************************************}
{==== ====}
{==== END OF HASH AND SPELLING TABLE PROCEDURES AND FUNCTIONS ====}
{=============================================================================}
{=============================================================================}
{*****************************************************************************}
{* PROCEDURE INITIALIZE - SETS UP SYSTEM AND ERASES OLD ERROR AND TEMP FILES *}
{*****************************************************************************}
PROCEDURE INITIALIZE;
{ GLOBAL CONSTANTS - MAXKEY, MAXCHARS }
{ GLOBAL VARIABLES - HASHTABLE: HASHTABLETYPE; SPELLTABLE: SPELLTABLETYPE; }
{ TOTALCHARS, LINENUM, NAMES: INTEGER; }
{ ASCII, SPECIAL, INVISIBLE, LETTERS, }
{ DIGITS, ALPHANUMERIC, SEPARATORS: CHARSET }
CONST
F = FALSE;
VAR
I: INTEGER;
FIL: FILE;
BEGIN
{------------- INITIALIZE THE SPELLING AND HASH TABLES -------------}
FOR I:= 1 TO MAXKEY DO
HASHTABLE[I]:= NIL;
FOR I:= 1 TO MAXCHARS DO
SPELLTABLE[I]:= #0;
{---------- ERASE OLD ERROR AND CODE OUTPUT FILES ------------}
ERROPENED:= FALSE; { INITIALIZE ERRORFILE VARIABLE }
IF EXIST('ERROR1.')
THEN
BEGIN
ASSIGN(FIL,'ERROR1.');
ERASE(FIL)
END;
IF EXIST('TEMP1.')
THEN
BEGIN
ASSIGN(FIL,'TEMP1.');
ERASE(FIL)
END;
{--------------- INITIALIZE THE COUNTING VARIABLES ---------------}
TOTALCHARS:= 0;
NAMES:= 100; { 101 WILL BE THE FIRST NAME ORDINAL VALUE }
LINENUM:= 0;
{-------------- ENTER STANDARD WORDS TO THE TABLES --------------}
DEFINE(F,'ARRAY',ORD(ARRAY1),5); DEFINE(F,'BEGIN',ORD(BEGIN1),5);
DEFINE(F,'BOOLEAN',ORD(BOOLEAN1),7); DEFINE(F,'CALL',ORD(CALL1),4);
DEFINE(F,'CONST',ORD(CONST1),5); DEFINE(F,'DO',ORD(DO1),2);
DEFINE(F,'END',ORD(END1),3); DEFINE(F,'FALSE',ORD(FALSE1),5);
DEFINE(F,'FI',ORD(FI1),2); DEFINE(F,'IF',ORD(IF1),2);
DEFINE(F,'INTEGER',ORD(INTEGER1),7); DEFINE(F,'OD',ORD(OD1),2);
DEFINE(F,'PROC',ORD(PROC1),4); DEFINE(F,'READ',ORD(READ1),4);
DEFINE(F,'SKIP',ORD(SKIP1),4); DEFINE(F,'TRUE',ORD(TRUE1),4);
DEFINE(F,'WRITE',ORD(WRITE1),5);
{-------------- INITIALIZE THE CHARACTER SETS --------------------}
ASCII:= [#0..#255];
INVISIBLE:= [#0..#31] + [#127] - [#10,#26];
LETTERS:= ['A'..'Z'] +['_'];
DIGITS:= ['0'..'9'];
ALPHANUMERIC:= LETTERS + DIGITS;
SEPARATORS:= [' ',#10,'$'];
SPECIAL:= ['.',',','~','[',']','(',')','\','/','*','|','&',';','+','-',
'=',':','<','>'];
{---------- SET UP SCREEN AND OPEN THE DISKS FILES FOR I/O ----------------}
CLRSCR;
WRITELN(
'PL SCANNER - SCANS PL SOURCE CODE AND CONVERTS IT TO CODE FOR THE PL PARSER'
);
LOWVIDEO;
WRITE('AUTHOR:');
NORMVIDEO;
WRITE(' JAY MONFORT ');
LOWVIDEO;
WRITE('FOR:');
NORMVIDEO;
WRITELN(' MATH 434, COMPILER DESIGN');
LOWVIDEO;
WRITE('DATE:');
NORMVIDEO;
WRITELN(' SEPTEMBER 25, 1986');
WRITELN; WRITELN;
OPEN_SOURCE; { OPEN SOURCE AND }
GOTOXY(20,9);
LOWVIDEO;
WRITE('LINE NUMBER: ');
NORMVIDEO;
OPEN_CODE { CODE FILES.... }
END; { PROCEDURE INITIALIZE }
{*****************************************************************************}
{*****************************************************************************}
{***** PROCEDURE FINALIZE - CLOSES UP ALL THE DISK FILES *****}
{*****************************************************************************}
PROCEDURE FINALIZE;
VAR
CHA: CHAR;
BEGIN
CLOSE(SOURCEFILE); { CLOSE UP THE FILES. }
FLUSH(CODEFILE);
CLOSE(CODEFILE);
IF ERROPENED
THEN
BEGIN
FLUSH(ERRFILE);
CLOSE(ERRFILE);
GOTOXY(10,11);
WRITE('ERRORS FOUND IN SOURCE CODE - FILE ERROR1 EXISTS'^G^G);
GOTOXY(20,13);
WRITE('CONTINUE??=(Y/N)=>');
REPEAT
READ(KBD,CHA)
UNTIL UPCASE(CHA) IN ['Y','N'];
IF UPCASE(CHA) = 'N'
THEN HALT(100)
END
END; { PROCEDURE FINALIZE }
{*****************************************************************************}
{=============================================================================}
{=============================================================================}
{==== MAIN SCANNING FUNCTIONS AND PROCEDURES ====}
{==== ====}
{*****************************************************************************}
{**** FUNCTION NEXTCHAR - RETURNS THE NEXT CHARACTER IN THE SOURCE CODE ****}
{*****************************************************************************}
FUNCTION NEXTCHAR: CHAR;
{ GLOBAL VARIABLES - SOURCEFILE: TEXT; ASCII, INVISIBLE: CHARSET }
VAR
CHA: CHAR;
BEGIN
REPEAT
READ(SOURCEFILE,CHA)
UNTIL CHA IN (ASCII - INVISIBLE);
NEXTCHAR:= UPCASE(CHA)
END; { FUNCTION NEXTCHAR }
{*****************************************************************************}
{*****************************************************************************}
{**** PROCEDURE EMIT, EMIT1 AND EMIT2 OUTPUT CODE NUMBERS TO THE CODE FILE****}
{*****************************************************************************}
{ GLOBAL VARIABLE - CODEFILE: TEXT }
PROCEDURE EMIT(VALUE: INTEGER);
BEGIN
WRITELN(CODEFILE,VALUE:8)
END;
{-----------------------------------------------------------------------------}
PROCEDURE EMIT1(VALUE: INTEGER);
BEGIN
WRITE(CODEFILE,VALUE:8)
END;
{-----------------------------------------------------------------------------}
PROCEDURE EMIT2(VALUE1, VALUE2: INTEGER);
BEGIN
EMIT1(VALUE1);
EMIT(VALUE2)
END;
{*****************************************************************************}
{*****************************************************************************}
{**** PROCEDURE NEWLINE - INCREMENTS LINENUM, EMITS NEWLINE ****}
{*****************************************************************************}
PROCEDURE NEWLINE;
{ GLOBAL VARIABLE - CH: CHAR }
BEGIN
CH:= NEXTCHAR;
LINENUM:= SUCC(LINENUM);
GOTOXY(33,9);
WRITE(LINENUM:5);
EMIT2(ORD(NEWLINE1),LINENUM)
END; { PROCEDURE NEWLINE }
{*****************************************************************************}
{*****************************************************************************}
{**** PROCEDURE COMMENT - SKIPS THROUGH COMMENTS ****}
{*****************************************************************************}
PROCEDURE COMMENT;
{ GLOBAL VARIABLE - CH: CHAR }
BEGIN
REPEAT
CH:= NEXTCHAR
UNTIL CH IN [#10,#26];
IF CH = #10
THEN NEWLINE
END; { PROCEDURE COMMENT }
{*****************************************************************************}
{*****************************************************************************}
{*** PROCEDURE SKIP_SEPARATORS - SKIPS THROUGH SPACES, COMMENTS AND EOLNS ***}
{*****************************************************************************}
PROCEDURE SKIP_SEPARATORS;
{ GLOBAL VARIABLES - CH: CHAR; SEPARATORS: CHARSET }
BEGIN
WHILE CH IN SEPARATORS DO
IF CH = ' '
THEN CH:= NEXTCHAR
ELSE
IF CH = #10
THEN NEWLINE
ELSE COMMENT
END; { PROCEDURE SKIP_SEPARATORS }
{*****************************************************************************}
{*****************************************************************************}
{PROCEDURE SCAN_WORDS GETS A STRING OF ALPHANUMERICS AND FEEDS IT TO SEARCHER }
{*****************************************************************************}
PROCEDURE SCAN_WORDS;
{ GLOBAL VARIABLES - CH: CHAR; ALPHANUMERIC: CHARSET }
VAR
WORD_LENGTH, INDEX: INTEGER;
THE_WORD: WRKSTRING;
ISNAME: BOOLEAN;
BEGIN
WORD_LENGTH:= 0;
WHILE CH IN ALPHANUMERIC DO
BEGIN
IF WORD_LENGTH < 80 { MAKE SURE IT FITS IN THE STRING }
THEN
BEGIN
WORD_LENGTH:= SUCC(WORD_LENGTH);
THE_WORD[WORD_LENGTH]:= CH
END;
CH:= NEXTCHAR
END;
SEARCH(THE_WORD,ISNAME,INDEX,WORD_LENGTH);
IF ISNAME
THEN EMIT2(ORD(NAME1),INDEX)
ELSE EMIT(INDEX)
END; { PROCEDURE SCAN_WORDS }
{*****************************************************************************}
{*****************************************************************************}
{ PROCEDURE SCAN_NUMERALS - CHECKS A SEQUENCE OF DIGITS AND MAKES AN INTEGER }
{*****************************************************************************}
PROCEDURE SCAN_NUMERALS;
{ GLOBAL VARIABLES - CH: CHAR; DIGITS: CHARSET }
VAR
VALUE: INTEGER;
DIGIT: 0..9;
BEGIN
VALUE:= 0;
WHILE CH IN DIGITS DO
BEGIN
DIGIT:= ORD(CH) - ORD('0');
IF VALUE <= (MAXINT - DIGIT) DIV 10
THEN
BEGIN
VALUE:= VALUE*10 + DIGIT;
CH:= NEXTCHAR
END
ELSE
BEGIN
ERROR(NUMERAL3);
WHILE CH IN DIGITS DO
CH:= NEXTCHAR
END
END;
EMIT2(ORD(NUMERAL1),VALUE)
END; { SCAN_NUMERALS }
{*****************************************************************************}
{*****************************************************************************}
{*** PROCEDURE SPECIAL_SYMBOLS - LOOKS FOR AND IDENTIFIES SPECIAL SYMBOLS ***}
{*****************************************************************************}
PROCEDURE SPECIAL_SYMBOLS;
{ GLOBAL VARIABLE - CH: CHAR }
BEGIN
CASE CH OF
'&': BEGIN
CH:= NEXTCHAR;
EMIT(ORD(AND1))
END;
'-': BEGIN
CH:= NEXTCHAR;
IF CH = '>'
THEN
BEGIN
CH:= NEXTCHAR;
EMIT(ORD(ARROW1))
END
ELSE EMIT(ORD(MINUS1))
END;
':': BEGIN
CH:= NEXTCHAR;
IF CH = '='
THEN
BEGIN
CH:= NEXTCHAR;
EMIT(ORD(BECOMES1))
END
ELSE
BEGIN
ERROR(UNKNOWN3);
EMIT(ORD(UNKNOWN1))
END
END;
',': BEGIN
CH:= NEXTCHAR;
EMIT(ORD(COMMA1))
END;
'/': BEGIN
CH:= NEXTCHAR;
EMIT(ORD(DIV1))
END;
'=': BEGIN
CH:= NEXTCHAR;
EMIT(ORD(EQUAL1))
END;
'>': BEGIN
CH:= NEXTCHAR;
EMIT(ORD(GREATER1))
END;
'[': BEGIN
CH:= NEXTCHAR;
IF CH = ']'
THEN
BEGIN
CH:= NEXTCHAR;
EMIT(ORD(PAIRED_BRACKETS1))
END
ELSE EMIT(ORD(LEFT_BRACKET1))
END;
'(': BEGIN
CH:= NEXTCHAR;
EMIT(ORD(LEFT_PAREN1))
END;
'<': BEGIN
CH:= NEXTCHAR;
EMIT(ORD(LESS1))
END;
'\': BEGIN
CH:= NEXTCHAR;
EMIT(ORD(MOD1))
END;
'*': BEGIN
CH:= NEXTCHAR;
EMIT(ORD(MULT1))
END;
'~': BEGIN
CH:= NEXTCHAR;
EMIT(ORD(NOT1))
END;
'|': BEGIN
CH:= NEXTCHAR;
EMIT(ORD(OR1))
END;
'.': BEGIN
CH:= NEXTCHAR;
EMIT(ORD(PERIOD1))
END;
'+': BEGIN
CH:= NEXTCHAR;
EMIT(ORD(PLUS1))
END;
']': BEGIN
CH:= NEXTCHAR;
EMIT(ORD(RIGHT_BRACKET1))
END;
')': BEGIN
CH:= NEXTCHAR;
EMIT(ORD(RIGHT_PAREN1))
END;
';': BEGIN
CH:= NEXTCHAR;
EMIT(ORD(SEMICOLON1))
END
END { CASE }
END; { PROCEDURE SPECIAL_SYMBOLS }
{*****************************************************************************}
{*****************************************************************************}
{**** PROCEDURE NEXTSYMBOL - LOOKS AT THE NEXT CHARACTER INPUT ****}
{*****************************************************************************}
PROCEDURE NEXTSYMBOL;
{ GLOBAL VARIABLES - CH: CHAR; LETTERS, DIGITS, SPECIAL: CHARSET }
BEGIN
SKIP_SEPARATORS;
IF CH IN LETTERS
THEN SCAN_WORDS
ELSE IF CH IN DIGITS
THEN SCAN_NUMERALS
ELSE IF CH IN SPECIAL
THEN SPECIAL_SYMBOLS
ELSE IF CH <> #26
THEN
BEGIN
CH:= NEXTCHAR;
EMIT(ORD(UNKNOWN1));
ERROR(UNKNOWN3)
END
END; { PROCEDURE NEXTSYMBOL }
{*****************************************************************************}
{*****************************************************************************}
{***** PROCEDURE SCAN - STARTS AND FINISHES THE SCAN *****}
{*****************************************************************************}
PROCEDURE SCAN;
BEGIN
NEWLINE; { GET FIRST CHARACTER, AND INC LINENUM }
WHILE CH <> #26 DO { AND FEED IT TO }
NEXTSYMBOL; { NEXTSYMBOL. }
EMIT(ORD(ENDTEXT1))
END; { PROCEDURE SCAN }
{*****************************************************************************}
{==== ====}
{==== END OF MAIN SCANNING PROCEDURES ====}
{=============================================================================}
{=============================================================================}
{=============================================================================}
{=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=}
{*****************************************************************************}
BEGIN { PROGRAM PL_SCAN }
INITIALIZE;
SCAN;
FINALIZE
END. { PROGRAM PL_SCAN }
{*****************************************************************************}
{*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*}
{=============================================================================}