home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 10 / scanner.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-07-22  |  10.9 KB  |  286 lines
  1. (* ----------------------------------------------------------------------- *)
  2. (*                                SCANNER.PAS                              *)
  3. (*                PASCAL baut einen Pascal-Compiler, Teil 3                *)
  4. (*      Prozedur zur Bestimmung des naechsten Symbols aus der Eingabe:     *)
  5. PROCEDURE insymbol;
  6. LABEL 1,2,3;
  7. VAR
  8.   i, k  :INTEGER;
  9.   digit : PACKED ARRAY[1..strglgth] OF CHAR; (* Buffer f. Ziffern *)
  10.   STRING: PACKED ARRAY[1..strglgth] OF CHAR; (* Buffer f. Stringkonstante *)
  11.   lvp   : csp;
  12.   test  : BOOLEAN;
  13.   wert  : long_integer;
  14. (* ----------------------------------------------------------------------- *)
  15. (*    liest das naechste Zeichen aus der Eingabe und weist es an ch zu:    *)
  16. PROCEDURE nextch;
  17. BEGIN
  18.   IF eol THEN
  19.     BEGIN
  20.       IF list THEN WriteLn(Output);        (* komplettes Compiler-Listing! *)
  21.       endofline;
  22.       linepos := 1;             (* Zeiger auf den Zeilenpuffer 'line', der
  23.                                     immer genau eine Eingabezeile aufnimmt *)
  24.     END;
  25.   IF NOT Eof(Input) THEN
  26.     BEGIN
  27.       eol := Eoln(Input);
  28.       Read(Input,ch);
  29.       enterline(ch);                     (* fuegt das neu gelesene Zeichen
  30.                                             in den Zeilenpuffer 'line' ein *)
  31.       IF list THEN Write(Output,ch);
  32.       chcnt := chcnt+1               (* 'charactercounter', Zeichenzaehler *)
  33.     END
  34.   ELSE
  35.     BEGIN
  36.       WriteLn(Output,'  *** eof encountered');  test := FALSE
  37.     END;
  38.  END;
  39. (* ----------------------------------------------------------------------- *)
  40. (* erkennt Compileroptionen, die mit (*$<Option>{+,-} eingeleitet werden.
  41.    Optionen sind :
  42.      l : kommentiertes Compiler-Listing
  43.      d : Debug-Option : Wenn diese eingeschaltet ist, wird Code zur Ueber-
  44.                         pruefung von Grenzbereichen, Aufzaehlungstypen ,...
  45.                         erzeugt.
  46.      c : Compiler-Option. Eingeschaltet erzeugt diese Option interpretier-
  47.                           baren P-Code                                     *)
  48. PROCEDURE options;
  49. BEGIN
  50.   REPEAT
  51.     nextch;
  52.     IF (ch <> '*') AND (ch <> '}') THEN
  53.     BEGIN
  54.       IF ch = 'l' THEN
  55.           BEGIN
  56.             nextch;  list := ch = '+';
  57.             IF NOT list THEN WriteLn(Output)
  58.           END
  59.       ELSE IF ch = 'd' THEN
  60.           BEGIN  nextch;  debug := ch = '+'  END
  61.       ELSE IF ch = 'c' THEN
  62.           BEGIN  nextch;  prcode := ch = '+'  END;
  63.       nextch
  64.     END
  65.   UNTIL ch <> ',';
  66. END;
  67. (* ----------------------------------------------------------------------- *)
  68. BEGIN (* of insymbol *)
  69. 1:
  70.   REPEAT
  71.     WHILE (ch = ' ') AND NOT eol DO nextch;       (* ueberlese Blanks..... *)
  72.     test := eol;
  73.     IF test THEN nextch                           (* ... und Separatoren.  *)
  74.   UNTIL NOT test;
  75.   IF chartp[ch] = illegal THEN
  76.                (* chartp gibt den Typ jedes Zeichens an. Es wird dabei
  77.                   nach Buchstaben, Ziffern und Sonderzeichen unterschieden *)
  78.     BEGIN                                    (* illegales Zeichen erkannt. *)
  79.       sy := othersy;  op := noop;   error(399);  nextch
  80.     END
  81.   ELSE
  82.     CASE chartp[ch] OF
  83.       letter:                                       (* Bezeichner einlesen *)
  84.         BEGIN
  85.           k := 0;
  86.           REPEAT
  87.             IF k < 8 THEN    (* Aufnahme des Bezeichners in Zwischenpuffer *)
  88.               BEGIN  k := k+1;  id[k] := ch  END;
  89.             nextch
  90.           (* Das Ende eines Bezeichners ist durch einen Separator bestimmt *)
  91.           UNTIL chartp[ch] IN [special,illegal,chstrquo,chcolon,
  92.                                 chperiod,chlt,chgt,chlparen,chspace];
  93.                             (* kk gibt die Laenge des letzten Bezeichners,
  94.                                      k die Laenge des neuen Bezeichners an *)
  95.           IF k >= kk THEN kk := k
  96.           ELSE
  97.             REPEAT                       (* Fuelle die unbenutzten Stellen *)
  98.                id[kk] := ' ';  kk := kk-1  (* des id-arrays mit Blanks auf *)
  99.             UNTIL kk = k;
  100.                                (* Der Bezeichner ist nun in id eingelesen. *)
  101.           FOR i := frw[k] TO frw[k+1]-1 DO
  102.             IF rw[i] = id THEN          (* ist id ein reserviertes Wort ?? *)
  103.               BEGIN                     (* jawoll, dem is' so...           *)
  104.                 sy := rsy[i];  op := rop[i];  GOTO 2
  105.               END;
  106.                                    (* Nee, id ist kein reserviertes Wort !.
  107.                                       id ist ein neudefinierter Bezeichner *)
  108.             sy := ident;  op := noop;
  109.           2:
  110.         END;
  111.       number:                                             (* Zahl einlesen *)
  112.         BEGIN
  113.           op := noop; i := 0;
  114.           REPEAT              (* Einlesen der Ziffern in den Ziffernpuffer *)
  115.             i := i+1;
  116.             IF i <= digmax THEN digit[i] := ch;
  117.             nextch
  118.           UNTIL chartp[ch] <> number;
  119.           IF (ch = '.') OR (ch = 'e') THEN
  120.             BEGIN                                     (* Realzahl einlesen *)
  121.               k := i;
  122.               IF ch = '.' THEN
  123.                 BEGIN
  124.                   k := k+1;
  125.                   IF k <= digmax THEN digit[k] := ch;
  126.                   nextch;
  127.                   IF ch = '.' THEN
  128.                     BEGIN  ch := ':';  GOTO 3  END;
  129.                   IF chartp[ch] <> number THEN error(201)
  130.                   ELSE
  131.                     REPEAT
  132.                       k := k+1;
  133.                       IF k <= digmax THEN digit[k] := ch;
  134.                       nextch
  135.                       UNTIL chartp[ch] <> number
  136.                 END;
  137.               IF ch = 'e' THEN
  138.                 BEGIN                                 (* Exponent einlesen *)
  139.                   k := k+1;
  140.                   IF k <= digmax THEN digit[k] := ch;
  141.                   nextch;
  142.                   IF (ch = '+') OR (ch = '-') THEN
  143.                     BEGIN
  144.                       k := k+1;
  145.                       IF k <= digmax THEN digit[k] := ch;
  146.                       nextch
  147.                     END;
  148.                   IF chartp[ch] <> number THEN error(201)
  149.                   ELSE
  150.                    REPEAT
  151.                      k := k+1;
  152.                      IF k <= digmax THEN digit[k] := ch;
  153.                      nextch
  154.                    UNTIL chartp[ch] <> number
  155.                 END;
  156.                                    (* Zahl ist in Ziffernpuffer eingelesen *)
  157.               New(lvp);  sy := realconst;  lvp^.cclass := reel;
  158.               WITH lvp^ DO
  159.                 BEGIN
  160.                   FOR i := 1 TO strglgth DO rval[i] := ' ';
  161.                   IF k <= digmax THEN
  162.                     FOR i := 2 TO k+1 DO rval[i] := digit[i-1]
  163.                   ELSE
  164.                     BEGIN
  165.                       error(203);
  166.                       rval[2] := '0';  rval[3] := '.';  rval[4] := '0'
  167.                     END
  168.                 END;
  169.               Val.valp := lvp
  170.             END
  171.           ELSE
  172.             3:
  173.             BEGIN                   (* Konstante ist vom Typ (long)integer *)
  174.               IF i > digmax THEN
  175.                 BEGIN  error(203);  Val.ival := 0  END
  176.               ELSE
  177.                 WITH Val DO
  178.                   BEGIN
  179.                     wert := 0;
  180.                     FOR k := 1 TO i DO  wert := wert*10+ordint[digit[k]];
  181.                     IF wert <= MaxInt THEN
  182.                       BEGIN                           (* integer-Konstante *)
  183.                         sy := intconst;  ival := Int(wert);
  184.                       END
  185.                     ELSE
  186.                       BEGIN                       (* longinteger-Konstante *)
  187.                         sy := longconst;  New(lvp);
  188.                         lvp^.cclass := long;  lvp^.lval := wert;
  189.                         Val.valp := lvp;
  190.                       END;
  191.                   END
  192.             END
  193.         END;
  194.       chstrquo:                                (* Stringkonstante einlesen *)
  195.         BEGIN
  196.           lgth := 0;  sy := stringconst;  op := noop;
  197.           REPEAT
  198.             REPEAT
  199.               nextch;  lgth := lgth+1;
  200.               IF lgth <= strglgth THEN STRING[lgth] := ch
  201.                             (* ^^ String in Stringpuffer zwischenspeichern *)
  202.             UNTIL (eol) OR (ch = '''');
  203.             if eol then error(202) else nextch
  204.           until ch <> '''';
  205.           lgth := lgth-1;
  206.           IF lgth = 0 THEN error(205)
  207.           ELSE IF lgth = 1 THEN Val.ival := Ord(STRING[1])
  208.                                        (* ^^ String ist einzelner Character*)
  209.           ELSE
  210.             BEGIN
  211.               New(lvp);  lvp^.cclass := strg;
  212.               IF lgth > strglgth THEN
  213.                 BEGIN
  214.                   error(399);  lgth := strglgth;   (* String zu lang, Rest *)
  215.                 END;                         (* wird einfach abgeschnitten *)
  216.               WITH lvp^ DO
  217.                 BEGIN
  218.                   slgth := lgth;
  219.                   FOR i := 1 TO lgth DO sval[i] := STRING[i]
  220.                 END;
  221.               Val.valp := lvp;
  222.             END
  223.         END;
  224.       chcolon:                                            (* SONDERZEICHEN *)
  225.         BEGIN
  226.           op := noop;  nextch;
  227.           IF ch = '=' THEN
  228.             BEGIN  sy := becomes;  nextch  END
  229.           ELSE  sy := colon
  230.         END;
  231.       chperiod:
  232.         BEGIN
  233.           op := noop;  nextch;
  234.           IF ch = '.' THEN
  235.             BEGIN  sy := colon;  nextch  END
  236.           ELSE  sy := period
  237.         END;
  238.       chlt:
  239.         BEGIN
  240.           nextch;  sy := relop;
  241.           IF ch = '=' THEN
  242.             BEGIN  op := leop;  nextch  END
  243.           ELSE IF ch = '>' THEN
  244.             BEGIN  op := neop;  nextch  END
  245.           ELSE  op := ltop
  246.         END;
  247.       chgt:
  248.         BEGIN
  249.           nextch;  sy := relop;
  250.           IF ch = '=' THEN
  251.             BEGIN  op := geop;  nextch  END
  252.           ELSE  op := gtop
  253.         END;
  254.       chlparen:                                              (* Kommentare *)
  255.         BEGIN
  256.           nextch;
  257.           IF ch = '*' THEN
  258.             BEGIN
  259.               nextch;
  260.               IF ch = '$' THEN options;
  261.               REPEAT
  262.                 WHILE (ch <> '*') AND NOT Eof(Input) DO nextch;
  263.                 nextch
  264.               UNTIL (ch = ')') OR Eof(Input);
  265.               nextch;  GOTO 1
  266.             END;
  267.             sy := lparent;  op := noop
  268.         END;
  269.       special:
  270.         BEGIN
  271.           sy := ssy[ch];  op := sop[ch];  nextch
  272.         END;
  273.       chspace:
  274.         sy := othersy;
  275.       lbrace:                                          (* Kommentare mit { *)
  276.         BEGIN
  277.           nextch;
  278.           IF ch = '$' THEN options;
  279.           WHILE (ch <> '}') AND NOT Eof(Input) DO nextch;
  280.           nextch;  GOTO 1
  281.         END;
  282.     END; (* of CASE *)
  283. END;
  284. (* ----------------------------------------------------------------------- *)
  285. (*                           Ende  SCANNER.PAS                             *)
  286.