Power-Programmierung/CD1.mdf/pascal/interpre/pl/scanner.pas

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 }
{*****************************************************************************}
{*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*}
{=============================================================================}