"AL HARTMANN
 INFORMATION SCIENCE
 CALIFORNIA INSTITUTE OF TECHNOLOGY
 PASADENA, CALIFORNIA 91125

 PDP 11/45 SEQUENTIAL PASCAL
 COMPILER PASS 1: LEXICAL ANALYSIS

 MARCH 1975"
(CHECK, NUMBER)

"###########
#  PREFIX  #
###########"

CONST              EOL = '(:10:)';     FF = '(:12:)';      EOM = '(:25:)';
PRINTLIMIT = 18;   MAXDIGIT = 6;
WORDLENGTH = 2 "BYTES";
REALLENGTH = 8 "BYTES";
SETLENGTH = 16 "BYTES";
SPLITLENGTH = 4 "WORDS PER SPLIT REAL";
MAX_STRING_LENGTH = 80 "CHARS";
WORDS_PER_STRING = 40 "MAX_STRING_LENGTH DIV WORDLENGTH";
LISTOPTION = 0;    SUMMARYOPTION = 1;  TESTOPTION = 2;     CHECKOPTION = 3;
CODEOPTION = 4;    NUMBEROPTION = 5;

"*****************************   CAUTION   ************************************"
"THE 'LARGEST_REAL' PROCEDURE IS MACHINE DEPENDANT. IT MAY HAVE TO BE CHANG&D  "
"IF THE COMPILER IS MOVED TO ANOTHER MACHINE .                                 "

TYPE FILE = 1..2;

CONST IDLENGTH = 12;
TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR;

TYPE   POINTER = @ INTEGER;
OPTION = LISTOPTION..NUMBEROPTION;
PASSPTR = @PASSLINK;
PASSLINK =
  RECORD
    OPTIONS: SET OF OPTION;
    LABELS, BLOCKS, CONSTANTS, RESETPOINT: INTEGER;
    TABLES: POINTER
  END;

TYPE ARGTAG =
  (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE);

TYPE ARGTYPE = RECORD
                 CASE TAG: ARGTAG OF
                   NILTYPE, BOOLTYPE: (BOOL: BOOLEAN);
                   INTTYPE: (INT: INTEGER);
                   IDTYPE: (ID: IDENTIFIER);
                   PTRTYPE: (PTR: PASSPTR)
               END;

CONST MAXARG = 10;
TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE;

CONST PAGELENGTH = 256;
TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF INTEGER;

PROCEDURE READ(VAR C: CHAR);
PROCEDURE WRITE(C: CHAR);
PROCEDURE NOTUSED1;
PROCEDURE NOTUSED2;
PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE);
PROCEDURE PUT(F: FILE; P: INTEGER; BLOCK: UNIV PAGE);
FUNCTION FILE_LENGTH(F:FILE): INTEGER;
PROCEDURE MARK(VAR TOP: INTEGER);
PROCEDURE RELEASE(TOP: INTEGER);

PROGRAM MAIN(VAR PARAM: ARGLIST);

"#############################################
#  PASS(VAR OK: BOOLEAN; VAR LINK: POINTER)  #
#############################################"

CONST

"OUTPUT OPERATORS"

EOM2=0;            BEGIN2=1;           IF2=2;              CASE2=3;
WHILE2=4;          REPEAT2=5;          FOR2=6;             WITH2=7;
ID2=8;             REAL2=9;            STRING2=10;         INTEGER2=11;
CHAR2=12;          OPEN2=13;           NOT2=14;            SUB2=15;
SET2=16;           ARRAY2=17;          RECORD2=18;         ARROW2=19;
PERIOD2=20;        STAR2=21;           SLASH2=22;          DIV2=23;
MOD2=24;           AND2=25;            PLUS2=26;           MINUS2=27;
OR2=28;            EQ2=29;             NE2=30;             LE2=31;
GE2=32;            LT2=33;             GT2=34;             IN2=35;
CONST2=36;         TYPE2=37;           VAR2=38;            PROCEDURE2=39;
FUNCTION2=40;      PROGRAM2=41;        SEMICOLON2=42;      CLOSE2=43;
UP_TO2=44;         OF2=45;             COMMA2=46;          BUS2=47;
COLON2=48;         END2=49;            FORWARD2=50;        UNIV2=51;
BECOMES2=52;       THEN2=53;           ELSE2=54;           DO2=55;
UNTIL2=56;         TO2=57;             DOWNTO2=58;         LCONST2=59;
MESSAGE2=60;       NEW_LINE2=61;

"OTHER CONSTANTS"

"ERRORS"

COMMENT_ERROR=1;   NUMBER_ERROR=2;     INSERT_ERROR=3;     STRING_ERROR=4;
CHAR_ERROR=5;

"STANDARD SPELLING/NOUN INDICES"

XUNDEF=0;          XFALSE=1;           XTRUE=2;            XINTEGER=3;
XBOOLEAN=4;        XCHAR=5;            XNIL=6;             XABS=7;
XATTRIBUTE=8;      XCHR=9;             XCONV=10;           XORD=11;
XPRED=12;          XSUCC=13;           XTRUNC=14;          XNEW=15;
XREAL=16;

ID_PIECE_LENGTH=9; "TEN CHARS PER PIECE"
MAX_PIECES = 13;  "FOURTEEN PIECES => 140 CHARS"
TEST_MAX = 50;
NULL=32767; "SYMBOL"
SPAN=26; "NUMBER OF DISTINCT ID CHARS"
THIS_PASS=1;
TEXT_LENGTH = 18;
INFILE = 1;        OUTFILE = 2;
HASH_MAX=750; "HASH TABLE UPPER BOUND"
HASH_MAX1=751; "PRIME LENGTH OF HASH TABLE"
MAX_INDEX=700; "MAX_LOADING=0.98 * HASH_MAX1-NO. OF RES.WDS."

MIN_ORD=0;         MAX_ORD=127;        MAX_INTEGER=32767;
INTEGER_LIMIT="(MAX_INTEGER-9) DIV 10" 3275;
MAX_EXPONENT=38;

TYPE

  SPLITREAL = ARRAY (.1..SPLITLENGTH.) OF INTEGER;

  TEXT_TYPE = ARRAY (.1..TEXT_LENGTH.) OF CHAR;

  PACKED_STRING = ARRAY (.1..WORDS_PER_STRING.) OF INTEGER;

  ALFA=ARRAY (.1..10.) OF CHAR;

  SPELLING_INDEX=INTEGER;

  PIECE=ARRAY(.0..ID_PIECE_LENGTH.) OF CHAR;

  PIECE_PTR=@ID_PIECE;

  ID_PIECE=
    RECORD
      PART:PIECE;
      NEXT:PIECE_PTR
    END;

VAR

  REAL0, REAL1, REAL10, MAX_REAL, REAL_LIMIT: REAL;

  INTER_PASS_PTR:PASSPTR;

  CH:CHAR;

  LETTERS, DIGITS, ALFAMERICS, NON_ALFAS,
  STRING_SPECIAL: SET OF CHAR;

  TEST, UPTO_SW, BUS_SW, END_SCAN: BOOLEAN;

  CL1,CL2,CL3,CL4 "LINE NUMBER": CHAR;

  LINE_NO:INTEGER;

  PIECES: INTEGER;      "ID LENGTH IN PIECES"

  TEST_BUF: ARRAY (.1..TEST_MAX.) OF INTEGER;

  TEST_INDEX: INTEGER;

  ID_TEXT: ARRAY(.0..MAX_PIECES.) OF PIECE;

  BLANK: PIECE "BLANK PADDING";

  CHAR_INDEX:0..ID_PIECE_LENGTH "CURRENT CHAR INDEX";

  SYMB: INTEGER "ID SYMBOL";

  STRING_LENGTH:INTEGER;

  HASH_KEY: 0..HASH_MAX; "INDEX TO HASH_TABLE"

  CURRENT_INDEX  "LAST ASSIGNED INDEX",
  INDEX  "LAST SCANNED INDEX"  : SPELLING_INDEX;

  STRING_TEXT: ARRAY (.1..MAX_STRING_LENGTH.) OF CHAR;

  HASH_TABLE:
    ARRAY (.0..HASH_MAX.) OF
      RECORD
        SPIX:SPELLING_INDEX;
        NAME:ID_PIECE
      END;

"############################"
"COMMON TEST OUTPUT MECHANISM"
"############################"

PRINTED: INTEGER;

OK: BOOLEAN;
  "PASS1 TO 6:  OK = NOT DISK OVERFLOW
   PASS7:       OK = NOT DISK OVERFLOW & PROGRAM CORRECT"

PAGE_IN: PAGE;  PAGES_IN, WORDS_IN: INTEGER;
PAGE_OUT: PAGE;  PAGES_OUT, WORDS_OUT: INTEGER;

PROCEDURE PRINT_TEXT (TEXT: TEXT_TYPE);
VAR I: INTEGER;
BEGIN
  WRITE(EOL);
  FOR I:= 1 TO TEXT_LENGTH DO WRITE(TEXT(.I.));
  WRITE(EOL)
END;

PROCEDURE FILE_LIMIT;
BEGIN
  PRINT_TEXT('PASS 1: FILE_LIMIT');
  OK:= FALSE
END;

PROCEDURE INIT_PASS (VAR LINK: PASSPTR);
BEGIN
  LINK:= PARAM(.2.).PTR;
  OK:= TRUE;
  PAGES_IN:= 1; WORDS_IN:= PAGELENGTH;
  PAGES_OUT:= 1; WORDS_OUT:= 0
END;

PROCEDURE NEXT_PASS (LINK: PASSPTR);
BEGIN
  IF WORDS_OUT > 0 THEN
    IF PAGES_OUT > FILE_LENGTH(OUTFILE) THEN FILE_LIMIT
      ELSE PUT(OUTFILE, PAGES_OUT, PAGE_OUT);
  WITH PARAM(.1.) DO BEGIN
    TAG:= BOOLTYPE; BOOL:=OK END;
  WITH PARAM(.2.) DO BEGIN
    TAG:= PTRTYPE; PTR:= LINK END;
  WITH PARAM(.4.) DO BEGIN
    TAG:= INTTYPE;  INT:= PAGES_OUT  END;
  WITH PARAM(.5.) DO BEGIN
    TAG:= BOOLTYPE; BOOL:= CH = EOM END;
END;

PROCEDURE READ_IFL (VAR I: INTEGER);
BEGIN
  IF WORDS_IN = PAGELENGTH THEN BEGIN
    IF PAGES_IN > FILE_LENGTH(INFILE) THEN FILE_LIMIT
    ELSE BEGIN
      GET(INFILE, PAGES_IN, PAGE_IN);
      PAGES_IN:= SUCC(PAGES_IN)
    END;
    WORDS_IN:= 0
  END;
  WORDS_IN:= SUCC(WORDS_IN);
  I:= PAGE_IN(.WORDS_IN.)
END;

PROCEDURE WRITE_IFL (I: INTEGER);
BEGIN
  WORDS_OUT:= SUCC(WORDS_OUT);
  PAGE_OUT(.WORDS_OUT.):= I;
  IF WORDS_OUT = PAGELENGTH THEN BEGIN
    IF PAGES_OUT > FILE_LENGTH(OUTFILE) THEN FILE_LIMIT
    ELSE BEGIN
      PUT(OUTFILE, PAGES_OUT, PAGE_OUT);
      PAGES_OUT:= SUCC(PAGES_OUT)
    END;
    WORDS_OUT:= 0
  END
END;

PROCEDURE SPLIT (INPUT: UNIV SPLITREAL; VAR OUTPUT: SPLITREAL);
BEGIN
  OUTPUT:= INPUT
END;

PROCEDURE LARGEST_REAL (VAR MAX: UNIV SPLITREAL);
BEGIN
  MAX(.1.):= 32767;
  MAX(.2.):= -1;
  MAX(.3.):= MAX(.2.);
  MAX(.4.):= MAX(.3.)
END;

PROCEDURE PRINTABS(ARG: INTEGER);
VAR T: ARRAY (.1..MAXDIGIT.) OF CHAR; REM, DIGIT, I: INTEGER;
BEGIN
  REM:= ARG; DIGIT:= 0;
  REPEAT
    DIGIT:= DIGIT + 1;
    T(.DIGIT.):= CHR(ABS(REM MOD 10) + ORD('0'));
    REM:= REM DIV 10;
  UNTIL REM = 0;
  FOR I:= DIGIT DOWNTO 1 DO WRITE(T(.I.));
  FOR I:= DIGIT + 1 TO MAXDIGIT DO WRITE(' ');
END;

PROCEDURE PRINTFF;
BEGIN WRITE(FF); PRINTED:= 0 END;

PROCEDURE PRINTEOL;
BEGIN WRITE(EOL); PRINTED:= 0 END;

PROCEDURE PRINTOP(OP: INTEGER);
BEGIN
  IF PRINTED = PRINTLIMIT THEN PRINTEOL;
  WRITE('C'); PRINTABS(OP);
  PRINTED:= PRINTED + 1;
END;

PROCEDURE PRINTARG(ARG: INTEGER);
BEGIN
  IF PRINTED = PRINTLIMIT THEN PRINTEOL;
  IF ARG < 0 THEN WRITE('-') ELSE WRITE(' ');
  PRINTABS(ARG);
  PRINTED:= PRINTED + 1;
END;

PROCEDURE STORE_TEST (ARG: INTEGER);
BEGIN
  IF TEST_INDEX < TEST_MAX THEN BEGIN
    TEST_INDEX:= TEST_INDEX + 1;
    TEST_BUF(.TEST_INDEX.):= ARG
  END
END;

PROCEDURE PRINT_TEST;
VAR I: INTEGER;
BEGIN
    PRINTED:= PRINTLIMIT;
  FOR I:= 1 TO TEST_INDEX DO PRINTARG(TEST_BUF(.I.));
  TEST_INDEX:= 0
END;

"NOTE: A PASS RUNNING WITH TEST OUTPUT SHOULD START
 BY CALLING PROCEDURE PRINTFF"

  PROCEDURE PUT_ARG(ARG:INTEGER);
  BEGIN
    WRITE_IFL(ARG);
    IF TEST THEN STORE_TEST(ARG)
  END;

  PROCEDURE PUT0NC(OP:INTEGER);
  BEGIN
    WRITE_IFL(OP);
    IF TEST THEN STORE_TEST(OP);
    WRITE(CH); READ(CH)
  END;

  PROCEDURE PUT0(OP:INTEGER);
  BEGIN
    WRITE_IFL(OP);
    IF TEST THEN STORE_TEST(OP)
  END;

  PROCEDURE PUT1(OP,ARG:INTEGER);
  BEGIN
    WRITE_IFL(OP); WRITE_IFL(ARG);
    IF TEST THEN BEGIN
      STORE_TEST(OP);  STORE_TEST(ARG)
    END
  END;

  PROCEDURE PUT2(OP,ARG1,ARG2:INTEGER);
  BEGIN
    WRITE_IFL(OP); WRITE_IFL(ARG1); WRITE_IFL(ARG2);
    IF TEST THEN BEGIN
      STORE_TEST(OP);  STORE_TEST(ARG1);  STORE_TEST(ARG2)
    END
  END;

  PROCEDURE PUT_STRING (STRING: UNIV PACKED_STRING; STRING_LENGTH: INTEGER);
  VAR I: INTEGER;
  BEGIN
    PUT1(STRING2, STRING_LENGTH);  PUT1(LCONST2, STRING_LENGTH);
    FOR I:= 1 TO STRING_LENGTH DIV WORDLENGTH DO
      PUT_ARG(STRING(.I.))
  END;

  PROCEDURE ERROR(ERROR_NUM:INTEGER);
  BEGIN
    PUT2(MESSAGE2,THIS_PASS,ERROR_NUM)
  END;

"##########"
"INITIALIZE"
"##########"

  PROCEDURE STD_ID(ID:PIECE; INDEX:SPELLING_INDEX);
  VAR S:SPELLING_INDEX; CHAR_INDEX:INTEGER;
  BEGIN
    HASH_KEY:=1;
    FOR CHAR_INDEX:=0 TO ID_PIECE_LENGTH DO
      IF ID(.CHAR_INDEX.)<>' ' THEN
        HASH_KEY:=HASH_KEY*(ORD(ID(.CHAR_INDEX.)) MOD SPAN +1) MOD HASH_MAX1;
    WHILE HASH_TABLE(.HASH_KEY.).SPIX<>NULL DO
      HASH_KEY:=(HASH_KEY+1) MOD HASH_MAX1;
    "NOW WE HAVE ENTRY SLOT"
    WITH HASH_TABLE(.HASH_KEY.) DO BEGIN
      SPIX:=INDEX;
      WITH NAME DO BEGIN PART:=ID; NEXT:=NIL END
    END
  END;

  PROCEDURE LONG_STD_ID(ID1,ID2:PIECE; INDEX:SPELLING_INDEX);
  VAR CHAR_INDEX:INTEGER;
  BEGIN
    HASH_KEY:=1;
    FOR CHAR_INDEX:=0 TO ID_PIECE_LENGTH DO
      HASH_KEY:=HASH_KEY*(ORD(ID1(.CHAR_INDEX.)) MOD SPAN +1) MOD HASH_MAX1;
    FOR CHAR_INDEX:=0 TO ID_PIECE_LENGTH DO
      IF ID2(.CHAR_INDEX.)<>' ' THEN
        HASH_KEY:=HASH_KEY*(ORD(ID2(.CHAR_INDEX.)) MOD SPAN+1) MOD HASH_MAX1;
    WHILE HASH_TABLE(.HASH_KEY.).SPIX<>NULL DO
      HASH_KEY:=(HASH_KEY+1) MOD HASH_MAX1;
    WITH HASH_TABLE(.HASH_KEY.) DO BEGIN
      SPIX:=INDEX;
      WITH NAME DO BEGIN
        PART:=ID1; NEW(NEXT);
        WITH NEXT@ DO BEGIN PART:=ID2; NEXT:=NIL END
      END
    END
  END;

  PROCEDURE STD_NAMES;
  BEGIN
    STD_ID('END       ',-END2);
    STD_ID('IF        ',-IF2);
    STD_ID('THEN      ',-THEN2);
    STD_ID('BEGIN     ',-BEGIN2);
    STD_ID('ELSE      ',-ELSE2);
    STD_ID('DO        ',-DO2);
    STD_ID('WITH      ',-WITH2);
    STD_ID('IN        ',-IN2);
    STD_ID('OF        ',-OF2);
    STD_ID('WHILE     ',-WHILE2);
    STD_ID('CASE      ',-CASE2);
    STD_ID('REPEAT    ',-REPEAT2);
    STD_ID('UNTIL     ',-UNTIL2);
    STD_ID('PROCEDURE ',-PROCEDURE2);
    STD_ID('VAR       ',-VAR2);
    STD_ID('FOR       ',-FOR2);
    STD_ID('ARRAY     ',-ARRAY2);
    STD_ID('RECORD    ',-RECORD2);
    STD_ID('SET       ',-SET2);
    STD_ID('TO        ',-TO2);
    STD_ID('DOWNTO    ',-DOWNTO2);
    STD_ID('MOD       ',-MOD2);
    STD_ID('OR        ',-OR2);
    STD_ID('AND       ',-AND2);
    STD_ID('NOT       ',-NOT2);
    STD_ID('DIV       ',-DIV2);
    STD_ID('CONST     ',-CONST2);
    STD_ID('TYPE      ',-TYPE2);
    STD_ID('FUNCTION  ',-FUNCTION2);
    STD_ID('FORWARD   ',-FORWARD2);
    STD_ID('UNIV      ',-UNIV2);
    STD_ID('PROGRAM   ',-PROGRAM2);
    STD_ID('FALSE     ',XFALSE);
    STD_ID('TRUE      ',XTRUE);
    STD_ID('INTEGER   ',XINTEGER);
    STD_ID('BOOLEAN   ',XBOOLEAN);
    STD_ID('CHAR      ',XCHAR);
    STD_ID('NIL       ',XNIL);
    STD_ID('NEW       ',XNEW);
    STD_ID('ABS       ',XABS);
    STD_ID('ATTRIBUTE ',XATTRIBUTE);
    STD_ID('CHR       ',XCHR);
    STD_ID('CONV      ',XCONV);
    STD_ID('ORD       ',XORD);
    STD_ID('PRED      ',XPRED);
    STD_ID('SUCC      ',XSUCC);
    STD_ID('TRUNC     ',XTRUNC);
    STD_ID('REAL      ',XREAL);
  END;

  PROCEDURE END_LINE;
  VAR I: INTEGER;
  BEGIN
    IF TEST THEN PRINT_TEST;
    WRITE(CH); READ(CH);
    LINE_NO:=LINE_NO+1;
    PUT1(NEW_LINE2,LINE_NO);
      IF CL4<'9' THEN CL4:=CHR(ORD(CL4)+1) ELSE BEGIN
        CL4:='0';
        IF CL3<'9' THEN CL3:=CHR(ORD(CL3)+1) ELSE BEGIN
          CL3:='0';
          IF CL2<'9' THEN CL2:=CHR(ORD(CL2)+1) ELSE BEGIN
            CL2:='0';
            IF CL1<'9' THEN CL1:=CHR(ORD(CL1)+1) ELSE CL1:='0'
          END
        END
      END;
      WRITE(CL1); WRITE(CL2); WRITE(CL3); WRITE(CL4); WRITE(' ');
    IF CH = ' ' THEN REPEAT WRITE(CH); READ(CH) UNTIL CH <> ' '
  END;

  PROCEDURE GET_CHAR(SKIP_FIRST: BOOLEAN);
  BEGIN
    IF SKIP_FIRST THEN BEGIN WRITE(CH); READ(CH) END;
    REPEAT
      IF CH='"' THEN BEGIN
        REPEAT
          REPEAT WRITE(CH); READ(CH) UNTIL (CH=EOL) OR (CH='"');
          WHILE CH = EOL DO END_LINE
        UNTIL (CH=EOM) OR (CH='"');
        IF CH = '"' THEN BEGIN WRITE(CH); READ(CH) END ELSE ERROR(COMMENT_ERROR)
      END;
      WHILE CH = ' ' DO BEGIN WRITE(CH); READ(CH) END;
      WHILE CH=EOL DO END_LINE
    UNTIL (CH<>' ') AND (CH<>'"')
  END;

  PROCEDURE INIT_OPTIONS;
  VAR STOP:SET OF CHAR;
  BEGIN
    END_LINE;
    NEW(INTER_PASS_PTR);
    WITH INTER_PASS_PTR@ DO BEGIN
      OPTIONS:=(.LISTOPTION,CHECKOPTION,NUMBEROPTION.);
      MARK(RESETPOINT);
      TABLES:=NIL;
      GET_CHAR(FALSE);
      IF CH='(' THEN BEGIN
        STOP:=(.',' , ')' , EOM.);
        REPEAT
          GET_CHAR(TRUE);
          IF CH='L' THEN OPTIONS:=OPTIONS-(.LISTOPTION.) ELSE
          IF CH='S' THEN OPTIONS:=OPTIONS OR (.SUMMARYOPTION.) ELSE
          IF CH='T' THEN OPTIONS:=OPTIONS OR (.TESTOPTION.) ELSE
          IF CH='C' THEN OPTIONS:=OPTIONS-(.CHECKOPTION.) ELSE
          IF CH='N' THEN OPTIONS:=OPTIONS-(.NUMBEROPTION.);
          WHILE NOT(CH IN STOP) DO GET_CHAR(TRUE)
        UNTIL (CH=EOM) OR (CH=')');
      IF CH=')' THEN BEGIN WRITE(CH); READ(CH) END
      END;
      IF TESTOPTION IN OPTIONS THEN BEGIN
        TEST:=TRUE;
        TEST_INDEX:= 0
      END
    END
  END;

  PROCEDURE INITIALIZE;
  VAR S:SPELLING_INDEX; C:MIN_ORD..MAX_ORD;
  BEGIN
    TEST:= FALSE;
    "EMPTY SET" PUT1(LCONST2,SETLENGTH);
    FOR S:=1 TO SETLENGTH DIV WORDLENGTH DO PUT_ARG(0);
    REAL0:= CONV(0);  REAL1:= CONV(1);  REAL10:= CONV(10);
    LARGEST_REAL(MAX_REAL);  REAL_LIMIT:= MAX_REAL / REAL10;
    CH:= EOL;
    END_SCAN:=FALSE;
    UPTO_SW:=FALSE; BUS_SW:=FALSE;
    LINE_NO:=0;
    CL1:='0'; CL2:='0'; CL3:='0'; CL4:='0';
    DIGITS:=(.'0','1','2','3','4','5','6','7','8','9'.);
    LETTERS:=(.'A','B','C','D','E','F','G','H','I','J','K','L',
      'M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z','_'.);
    ALFAMERICS:=LETTERS OR DIGITS;
    NON_ALFAS:= (..);
    FOR C:= MIN_ORD TO MAX_ORD DO NON_ALFAS:= NON_ALFAS OR (.CHR(C).);
    NON_ALFAS:= NON_ALFAS - ALFAMERICS;
    STRING_SPECIAL:= (.'''', EOL, EOM, '('.);
    BLANK:='          ';
    FOR S:=0 TO HASH_MAX DO HASH_TABLE(.S.).SPIX:=NULL;
    CURRENT_INDEX:=XREAL;
    STD_NAMES;
    INIT_OPTIONS;
  END;

"######"
"NUMBER"
"######"

  PROCEDURE NUMBER;
  VAR MANTISSA,POWER_OF_TEN, RESULT: REAL;
    ERROR_SW,EXPONENT_SIGN:BOOLEAN;
    REAL_VAL:SPLITREAL; OP:INTEGER;
    EXPONENT,EXPONENT_PART,I:INTEGER;
  BEGIN
    OP:= INTEGER2;  MANTISSA:= REAL0;  ERROR_SW:= FALSE;  EXPONENT:= 0;
    "COLLECT INTEGER PART"
    REPEAT
      IF MANTISSA<=REAL_LIMIT THEN
        MANTISSA:=MANTISSA*REAL10 + CONV(ORD(CH)-ORD('0'))
      ELSE ERROR_SW:=TRUE;
      WRITE(CH);  READ(CH)
    UNTIL NOT(CH IN DIGITS);
    "COLLECT FRACTIONAL PART"
    IF CH='.' THEN BEGIN
      WRITE(CH); READ(CH);
      IF CH=')' THEN BUS_SW:=TRUE ELSE
      IF CH='.' THEN UPTO_SW:=TRUE ELSE
      BEGIN
        OP:=REAL2;
        IF NOT(CH IN DIGITS) THEN ERROR(NUMBER_ERROR) ELSE
        REPEAT
          IF MANTISSA <= REAL_LIMIT THEN BEGIN
            MANTISSA:=MANTISSA*REAL10 + CONV(ORD(CH)-ORD('0'));
            EXPONENT:=EXPONENT-1
          END;
          WRITE(CH); READ(CH)
        UNTIL NOT(CH IN DIGITS);
      END
    END;
    "COLLECT EXPONENT PART"
    IF CH='E' THEN BEGIN
      OP:=REAL2;
      WRITE(CH); READ(CH);
      EXPONENT_PART:=0; EXPONENT_SIGN:=FALSE;
      IF CH='+' THEN BEGIN WRITE(CH); READ(CH) END ELSE
      IF CH='-' THEN BEGIN
        EXPONENT_SIGN:= TRUE; WRITE(CH); READ(CH)
      END;
      IF NOT(CH IN DIGITS) THEN ERROR(NUMBER_ERROR) ELSE
      REPEAT
        IF EXPONENT_PART<=INTEGER_LIMIT THEN
          EXPONENT_PART:=EXPONENT_PART*10-ORD('0') +ORD(CH)
        ELSE ERROR_SW:=TRUE;
        WRITE(CH); READ(CH)
      UNTIL NOT(CH IN DIGITS);
      "ASSERT EXPONENT <= 0;"
      IF EXPONENT_SIGN THEN
        IF MAX_EXPONENT + EXPONENT >= EXPONENT_PART
        THEN EXPONENT:= EXPONENT - EXPONENT_PART
        ELSE ERROR_SW:= TRUE
        ELSE EXPONENT:=EXPONENT+EXPONENT_PART
    END;
    "NOW CONSTRUCT THE NUMBER"
    IF OP=INTEGER2 THEN BEGIN
      IF MANTISSA>CONV(MAX_INTEGER) THEN BEGIN
        ERROR(NUMBER_ERROR); MANTISSA:= REAL0
      END;
      PUT1(INTEGER2,TRUNC(MANTISSA))
    END ELSE "OP=REAL2" BEGIN
      IF ERROR_SW THEN BEGIN
        ERROR(NUMBER_ERROR);
        SPLIT(REAL0, REAL_VAL)
      END ELSE BEGIN
        "COMPUTE THE APPROPRIATE POWER OF TEN"
        POWER_OF_TEN:=REAL1;
        IF EXPONENT<0 THEN BEGIN
          EXPONENT_SIGN:=TRUE;
          EXPONENT:=ABS(EXPONENT)
        END ELSE EXPONENT_SIGN:=FALSE;
        IF EXPONENT>MAX_EXPONENT THEN BEGIN
          ERROR(NUMBER_ERROR);
          EXPONENT:=0
        END;
        FOR I:=1 TO EXPONENT DO POWER_OF_TEN:=POWER_OF_TEN*REAL10;
        "NOW EITHER MANTISSA=0.0 OR MANTISSA>=1.0"
        IF MANTISSA = REAL0 THEN RESULT:= REAL0 ELSE
        IF EXPONENT_SIGN THEN RESULT:= MANTISSA / POWER_OF_TEN ELSE
        "IF MANTISSA>=1.0 THEN WE MUST HAVE:
          MANTISSA*POWER_OF_TEN<=MAX_REAL
          => POWER_OF_TEN<=MAX_REAL/MANTISSA<=MAX_REAL"
        IF POWER_OF_TEN<=MAX_REAL/MANTISSA THEN
          RESULT:= MANTISSA * POWER_OF_TEN
        ELSE BEGIN
          ERROR(NUMBER_ERROR); RESULT:= REAL0
        END;
        SPLIT(RESULT, REAL_VAL)
      END;
      PUT0(REAL2);
      PUT1(LCONST2,REALLENGTH);
      FOR I:= 1 TO SPLITLENGTH DO PUT_ARG(REAL_VAL(.I.))
    END
  END;

"#######"
"HASHING"
"#######"

  FUNCTION SAME_ID:BOOLEAN;
  VAR SAME:BOOLEAN; THIS_PIECE:PIECE_PTR; I:INTEGER;
  BEGIN
    WITH HASH_TABLE(.HASH_KEY.) DO BEGIN
      SAME:=NAME.PART=ID_TEXT(.0.);
      IF PIECES>0 THEN
        IF SAME THEN BEGIN
          THIS_PIECE:=NAME.NEXT;
          I:=1;
          REPEAT
            IF THIS_PIECE=NIL THEN BEGIN
              SAME:=FALSE "CANDIDATE IS TOO SHORT";
              I:=PIECES+1 "QUIT"
            END ELSE BEGIN "COMPARE AND INCREMENT"
              SAME:=SAME AND (THIS_PIECE@.PART=ID_TEXT(.I.));
              THIS_PIECE:=THIS_PIECE@.NEXT;
              I:=I+1;
            END
          UNTIL I>PIECES;
          SAME:=SAME AND (THIS_PIECE=NIL)
        END;
      SAME_ID:=SAME
    END
  END;

  PROCEDURE INSERT_ID;
  VAR I:INTEGER; P,P1:PIECE_PTR;
  BEGIN
    WITH HASH_TABLE(.HASH_KEY.) DO BEGIN
      CURRENT_INDEX:=CURRENT_INDEX+1;
      IF CURRENT_INDEX>=MAX_INDEX THEN BEGIN
        ERROR(INSERT_ERROR); CH:=EOM; WRITE(EOL)
      END;
      SPIX:=CURRENT_INDEX;
      WITH NAME DO BEGIN PART:=ID_TEXT(.0.); NEXT:=NIL END;
      IF PIECES>0 THEN BEGIN
        NEW(P); NAME.NEXT:=P; P@.PART:=ID_TEXT(.1.);
        FOR I:=2 TO PIECES DO BEGIN
          NEW(P1); P@.NEXT:=P1;
          P1@.PART:=ID_TEXT(.I.); P:=P1
        END;
        P@.NEXT:=NIL
      END
    END
  END;

  PROCEDURE SEARCH_ID;
  VAR FINISHED:BOOLEAN;
  BEGIN
    FINISHED:=FALSE;
    REPEAT
      WITH HASH_TABLE(.HASH_KEY.) DO
        IF SPIX<>NULL THEN
            IF SAME_ID THEN "FOUND IT" BEGIN
              FINISHED:=TRUE;
              IF SPIX>=0 THEN BEGIN
                SYMB:=ID2; INDEX:=SPIX
              END ELSE SYMB:=ABS(SPIX)
            END ELSE HASH_KEY:=(HASH_KEY+1) MOD HASH_MAX1
        ELSE "SYM=NULL" BEGIN
          INSERT_ID;
          SYMB:=ID2;
          INDEX:=CURRENT_INDEX;
          FINISHED:=TRUE
        END
    UNTIL FINISHED "WITH SEARCH"
  END;

"######"
"STRING"
"######"

  PROCEDURE STRING_CHAR;
  BEGIN
   IF STRING_LENGTH = MAX_STRING_LENGTH THEN ERROR(STRING_ERROR)
   ELSE BEGIN
    STRING_LENGTH:=STRING_LENGTH+1;
    STRING_TEXT(.STRING_LENGTH.):= CH;
      WRITE(CH); READ(CH)
   END
  END;

  PROCEDURE STRING;
  VAR ORD_VALUE, I: INTEGER;  DONE: BOOLEAN;
  BEGIN
    STRING_LENGTH:=0;
    WRITE(CH); READ(CH); DONE:= FALSE;
    REPEAT
      WHILE NOT (CH IN STRING_SPECIAL) DO STRING_CHAR;
      CASE CH OF
        '''':
          BEGIN
            STRING_CHAR;
            IF CH = '''' THEN BEGIN WRITE(CH); READ(CH) END ELSE DONE:= TRUE
          END;
        EOL, EOM:
          BEGIN
            ERROR (STRING_ERROR);
            DONE:= TRUE
          END;
        '(':
          BEGIN
            STRING_CHAR;
            IF CH = ':' THEN BEGIN
            REPEAT WRITE(CH); READ(CH) UNTIL CH <> ' ';
              ORD_VALUE:= 0;
              IF CH IN DIGITS THEN
                REPEAT
                  IF ORD_VALUE <= MAX_ORD THEN
                    ORD_VALUE:= ORD_VALUE * 10 + (ORD(CH) - ORD('0'));
                WRITE(CH); READ(CH)
                UNTIL NOT (CH IN DIGITS)
              ELSE ERROR (STRING_ERROR);
          WHILE CH=' ' DO BEGIN WRITE(CH); READ(CH) END;
          IF CH=':' THEN BEGIN WRITE(CH); READ(CH) END ELSE ERROR(STRING_ERROR);
          IF CH=')' THEN BEGIN WRITE(CH); READ(CH) END ELSE ERROR(STRING_ERROR);
              IF ORD_VALUE > MAX_ORD THEN BEGIN
                ERROR(STRING_ERROR);
                ORD_VALUE:= ORD('?')
              END;
              STRING_TEXT(.STRING_LENGTH.):= CHR(ORD_VALUE)
            END
          END
      END
    UNTIL DONE;
    IF STRING_LENGTH <= 1 THEN BEGIN
      ERROR(STRING_ERROR);
      STRING_LENGTH:= 1;  STRING_TEXT(.1.):= '?'
    END ELSE STRING_LENGTH:= STRING_LENGTH - 1;
    IF STRING_LENGTH > 1 THEN IF STRING_LENGTH MOD WORDLENGTH <> 0 THEN
      BEGIN ERROR(STRING_ERROR); STRING_LENGTH:= 1 END;
    IF STRING_LENGTH = 1 THEN PUT1(CHAR2, ORD(STRING_TEXT(.1.)))
    ELSE PUT_STRING(STRING_TEXT, STRING_LENGTH)
  END;

"##########"
"IDENTIFIER"
"##########"

  PROCEDURE IDENTIFIER;
  BEGIN
    PIECES:=-1; CHAR_INDEX:=ID_PIECE_LENGTH;
    HASH_KEY:= 1;
    REPEAT
      IF CHAR_INDEX=ID_PIECE_LENGTH THEN BEGIN
        CHAR_INDEX:= 0;  PIECES:= SUCC(PIECES);
        ID_TEXT(.PIECES.):=BLANK;
      END ELSE CHAR_INDEX:= SUCC(CHAR_INDEX);
      ID_TEXT(.PIECES,CHAR_INDEX.):=CH;
      HASH_KEY:=HASH_KEY*(ORD(CH) MOD SPAN +1) MOD HASH_MAX1;
      WRITE(CH); READ(CH)
    UNTIL CH IN NON_ALFAS;
    SEARCH_ID;
    IF SYMB=ID2 THEN PUT1(ID2,INDEX)
    ELSE BEGIN
      PUT0(SYMB);
      IF SYMB=END2 THEN BEGIN
        GET_CHAR(FALSE);
        IF CH='.' THEN BEGIN
          PUT0(PERIOD2);
          REPEAT WRITE(CH); READ(CH) UNTIL CH = EOL;
          WRITE(CH);
          END_SCAN:=TRUE
        END
      END
    END
  END;

"#######"
"SCANNER"
"#######"

  PROCEDURE SCAN;
  BEGIN
    REPEAT
      CASE CH OF
        ' ':
          BEGIN WRITE(CH); READ(CH) END;

        EOL:
          END_LINE;

        EOM:
          END_SCAN:=TRUE;

        '"': BEGIN
          REPEAT
        REPEAT WRITE(CH); READ(CH) UNTIL (CH = '"') OR (CH = EOL);
            WHILE CH = EOL DO END_LINE
          UNTIL (CH='"') OR (CH=EOM);
        IF CH=EOM THEN ERROR(COMMENT_ERROR) ELSE BEGIN WRITE(CH); READ(CH) END
        END;

        '.': BEGIN
        WRITE(CH); READ(CH);
          IF UPTO_SW THEN BEGIN
            PUT0(UP_TO2);
            UPTO_SW:=FALSE
          END ELSE IF CH='.' THEN PUT0NC(UP_TO2)
          ELSE IF CH=')' THEN PUT0NC(BUS2)
          ELSE PUT0(PERIOD2)
        END;

        ':' : BEGIN
        WRITE(CH); READ(CH);
          IF CH='=' THEN PUT0NC(BECOMES2) ELSE PUT0(COLON2)
        END;

        '<': BEGIN
        WRITE(CH); READ(CH);
          IF CH='=' THEN PUT0NC(LE2) ELSE
          IF CH='>' THEN PUT0NC(NE2) ELSE
          PUT0(LT2)
        END;

        '=':
          PUT0NC(EQ2);

        '>': BEGIN
        WRITE(CH); READ(CH);
          IF CH='=' THEN PUT0NC(GE2) ELSE PUT0(GT2)
        END;

        '''':
          STRING;

        '0','1','2','3','4','5','6','7','8','9':
          NUMBER;

        'A','B','C','D','E','F','G','H','I','J','K','L','M','N',
        'O','P','Q','R','S','T','U','V','W','X','Y','Z','_':
          IDENTIFIER;

        '(': BEGIN
        WRITE(CH); READ(CH);
          IF CH='.' THEN PUT0NC(SUB2) ELSE PUT0(OPEN2)
        END;

        ')':
          IF BUS_SW THEN BEGIN
            PUT0NC(BUS2);
            BUS_SW:=FALSE
          END ELSE PUT0NC(CLOSE2);

        ',':
          PUT0NC(COMMA2);

        ';':
          PUT0NC(SEMICOLON2);

        '*':
          PUT0NC(STAR2);

        '/':
          PUT0NC(SLASH2);

        '+':
          PUT0NC(PLUS2);

        '-':
          PUT0NC(MINUS2);

        '&':
          PUT0NC(AND2);

        '@':
          PUT0NC(ARROW2);

      '(:0:)', '(:1:)', '(:2:)', '(:3:)', '(:4:)', '(:5:)', '(:6:)', '(:7:)',
        '(:8:)', '(:9:)', '(:11:)', '(:12:)', '(:13:)', '(:14:)', '(:15:)',
        '(:16:)', '(:17:)', '(:18:)', '(:19:)', '(:20:)', '(:21:)', '(:22:)',
        '(:23:)', '(:24:)', '(:26:)', '(:27:)', '(:28:)', '(:29:)', '(:30:)',
        '(:31:)', '(:33:)', '(:35:)', '(:36:)', '(:37:)', '(:63:)', '(:91:)',
        '(:92:)', '(:93:)', '(:94:)',           '(:96:)', '(:97:)', '(:98:)',
        '(:99:)', '(:100:)', '(:101:)', '(:102:)', '(:103:)', '(:104:)',
        '(:105:)', '(:106:)', '(:107:)', '(:108:)', '(:109:)', '(:110:)',
        '(:111:)', '(:112:)', '(:113:)', '(:114:)', '(:115:)', '(:116:)',
        '(:117:)', '(:118:)', '(:119:)', '(:120:)', '(:121:)', '(:122:)',
        '(:123:)', '(:124:)', '(:125:)', '(:126:)', '(:127:)':
          BEGIN
        WRITE('?'); READ(CH);
          ERROR(CHAR_ERROR)
          END
      END
    UNTIL END_SCAN;
    PUT0(EOM2)
  END;

"####"
"MAIN"
"####"

BEGIN
  INIT_PASS(INTER_PASS_PTR);
  INITIALIZE;
  SCAN;
  RELEASE(INTER_PASS_PTR@.RESETPOINT);
  NEXT_PASS(INTER_PASS_PTR)
END.
);