home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / compcomp / tpyacc / scanner.l < prev    next >
Text File  |  1992-09-19  |  17KB  |  535 lines
  1. %{
  2. (* ---------------------------------------------------------------- *)
  3. (*                                                                  *)
  4. (*                                                                  *)
  5. (* (c) rr, 9.9., 19.9.,                                             *)
  6. (* ---------------------------------------------------------------- *)
  7.  
  8. CONST
  9.   HexBase = 16;
  10.   DecBase = 10;
  11.   BinBase = 2;
  12.   OctBase = 8;
  13.  
  14. PROCEDURE MakeInt (S: STRING; FixBase: BYTE);
  15.   CONST
  16.     Values: ARRAY [0..15] OF CHAR =
  17.               ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9',
  18.                'A', 'B', 'C', 'D', 'E', 'F');
  19.   VAR
  20.     i:     INTEGER;
  21.     v:     LONGINT;
  22.     Error: BOOLEAN;
  23.     Base:  LONGINT;
  24.  
  25.  
  26.   FUNCTION Index (c: CHAR): BYTE;
  27.     VAR j, i: BYTE;
  28.   BEGIN
  29.     j := 16;
  30.     i := 0;
  31.     FOR i := 0 TO 15 DO
  32.       IF UpCase (c) = Values [i] THEN
  33.         j := i;
  34.     IF j > 15 THEN
  35.       Error := TRUE;     { Zeichen ungültig ! }
  36.     Index := j;
  37.   END;
  38.  
  39. BEGIN
  40.   Error := FALSE;
  41.   Base := FixBase;
  42.   v := Index (s [Length (s)]) * 1;
  43.   FOR i := Length (S)-1 DOWNTO 1 DO BEGIN
  44.     v := v + Index (s [i]) * Base;
  45.     Base := Base * FixBase;
  46.   END;
  47.   IF NOT Error THEN BEGIN
  48.     yylVal.yyInteger := v;
  49.     Return (UNSIGNED_INTEGER);
  50.   END ELSE BEGIN
  51.     Writeln ('Error: Number too big');
  52.     Return (ILLEGAL);
  53.   END;
  54. END;
  55.  
  56. PROCEDURE Commenteof;
  57. BEGIN
  58.   Writeln ('Unexpected EOF inside Comment at line ', yyLineNo);
  59. END;
  60.  
  61. FUNCTION Upper (Str: STRING): STRING;
  62.   VAR i: INTEGER;
  63. BEGIN
  64.   FOR i := 1 TO Length (str) DO
  65.     str [i] := UpCase (str [i]);
  66.   Upper := Str;
  67. END;
  68.  
  69. FUNCTION isKeyword (ID: STRING; VAR Token: INTEGER): BOOLEAN;
  70.   CONST
  71.     idLen = 20;
  72.  
  73.   TYPE
  74.     Ident = STRING [idLen];
  75.  
  76.   CONST
  77.     NoOfKeywords = 57;
  78.     KeyWords: ARRAY [1..NoOfKeywords] of Ident = (
  79.       'ABSOLUTE',    'AND',         'ARRAY',       'ASM',
  80.       'ASSEMBLER',   'BEGIN',       'CASE',        'CONST',
  81.       'CONSTRUCTOR', 'DESTRUCTOR',  'DIV',         'DO',
  82.       'DOWNTO',      'ELSE',        'END',         'EXTERNAL',
  83.       'FAR',         'FILE',        'FOR',         'FORWARD',
  84.       'FUNCTION',    'GOTO',        'IF',          'IMPLEMENTATION',
  85.       'IN',          'INLINE',      'INTERFACE',   'INTERRUPT',
  86.       'LABEL',       'MOD',         'NEAR',        'NIL',
  87.       'NOT',         'OBJECT',      'OF',          'OR',
  88.       'PACKED',      'PRIVATE',     'PROCEDURE',   'PROGRAM',
  89.       'RECORD',      'REPEAT',      'SET',         'SHL',
  90.       'SHR',         'STRING',      'THEN',        'TO',
  91.       'TYPE',        'UNIT',        'UNTIL',       'USES',
  92.       'VAR',         'VIRTUAL',     'WHILE',       'WITH',
  93.       'XOR');
  94.  
  95.     KeywordTokens: ARRAY [1..NoOfKeywords] OF INTEGER = (
  96.       _ABSOLUTE_,    _AND_,         _ARRAY_,       _ASM_,
  97.       _ASSEMBLER_,   _BEGIN_,       _CASE_,        _CONST_,
  98.       _CONSTRUCTOR_, _DESTRUCTOR_,  _DIV_,         _DO_,
  99.       _DOWNTO_,      _ELSE_,        _END_,         _EXTERNAL_,
  100.       _FAR_,         _FILE_,        _FOR_,         _FORWARD_,
  101.       _FUNCTION_,    _GOTO_,        _IF_,          _IMPLEMENTATION_,
  102.       _IN_,          _INLINE_,      _INTERFACE_,   _INTERRUPT_,
  103.       _LABEL_,       _MOD_,         _NEAR_,        _NIL_,
  104.       _NOT_,         _OBJECT_,      _OF_,          _OR_,
  105.       _PACKED_,      _PRIVATE_,     _PROCEDURE_,   _PROGRAM_,
  106.       _RECORD_,      _REPEAT_,      _SET_,         _SHL_,
  107.       _SHR_,         _STRING_,      _THEN_,        _TO_,
  108.       _TYPE_,        _UNIT_,        _UNTIL_,       _USES_,
  109.       _VAR_,         _VIRTUAL_,     _WHILE_,       _WITH_,
  110.       _XOR_);
  111.  
  112.   VAR m, n, k: INTEGER;
  113.  
  114.   BEGIN
  115.     id := Upper (id);
  116.     (* Binäre Suche (Bisektionssuche): *)
  117.     m := 1; n := NoOfKeywords;
  118.     WHILE m <= n DO BEGIN
  119.       k := m + (n-m) DIV 2;
  120.       IF id = KeyWords [k] THEN BEGIN
  121.         isKeyword := TRUE;
  122.         Token := KeywordTokens[k];
  123.         Exit;
  124.       END ELSE
  125.         IF id > Keywords [k] THEN
  126.           m := k+1
  127.         ELSE
  128.           n := k-1
  129.       END;
  130.     isKeyword := FALSE;
  131.   END;
  132.  
  133. FUNCTION isAssemblerKeyword (ID: STRING; VAR Token: INTEGER): BOOLEAN;
  134.   CONST
  135.     idLen = 10;
  136.  
  137.   TYPE
  138.     Ident = STRING [idLen];
  139.  
  140.   CONST
  141.     NoOfKeywords = 181;
  142.     KeyWords: ARRAY [1..NoOfKeywords] of Ident = (
  143.         'LOCK',      'REP',       'REPE',      'REPZ',      'REPNE',
  144.         'REPNZ',     'SEGCS',     'SEGDS',     'SEGES',     'SEGSS',
  145.         'DB',        'DW',        'DD',        'AH',        'DH',
  146.         'DX',        'OR',        'ST',        'AL',        'CL',
  147.         'ES',        'PTR',       'TBYTE',     'AND',       'CS',
  148.         'FAR',       'QWORD',     'TYPE',      'AX',        'CX',
  149.         'HIGH',      'SEG',       'WORD',      'BH',        'DH',
  150.         'LOW',       'SHL',       'XOR',       'BL',        'DI',
  151.         'MOD',       'SHR',       'BP',        'DL',        'NEAR',
  152.         'SI',        'BX',        'DS',        'NOT',       'SP',
  153.         'BYTE',      'DWORD',     'OFFSET',    'SS',        'CODE',
  154.         'DATA',      'RESULT',    'AAA',       'AAD',       'AAM',
  155.         'AAS',       'ADC',       'ADD',       'AND',       'BOUND',
  156.         'CALL',      'CBW',       'CDQ',       'CLC',       'CLD',
  157.         'CLI',       'CMC',       'CMP',       'CMPS',      'CMPSB',
  158.         'CMPSW',     'DAA',       'DAS',       'DEC',       'DIV',
  159.         'ENTER',     'HLT',       'IDIV',      'IMUL',      'IN',
  160.         'INC',       'INS',       'INSB',      'INSW',      'INT',
  161.         'INTO',      'IRET',      'JA',        'JAE',       'JB',
  162.         'JBE',       'JC',        'JCXZ',      'JE',        'JZ',
  163.         'JG',        'JGE',       'JL',        'JLE',       'JNA',
  164.         'JNAE',      'JNB',       'JNBE',      'JNC',       'JNE',
  165.         'JNG',       'JNGE',      'JNL',       'JNLE',      'JNO',
  166.         'JNP',       'JNS',       'JNZ',       'JO',        'JP',
  167.         'JPE',       'JPO',       'JS',        'JZ',        'JMP',
  168.         'LAHF',      'LEA',       'LEAVE',     'LOCK',      'LODS',
  169.         'LODSB',     'LODSW',     'LOOP',      'LOOPE',     'LOOPZ',
  170.         'LOOPNE',    'LOOPNZ',    'MOV',       'MOVS',      'MOVSB',
  171.         'MOVSW',     'MUL',       'NEG',       'NOP',       'NOT',
  172.         'OR',        'OUT',       'OUTS',      'OUTSB',     'OUTSW',
  173.         'POP',       'POPF',      'PUSH',      'PUSHF',     'RCL',
  174.         'RCR',       'ROL',       'ROR',       'RET',       'SAHF',
  175.         'SAL',       'SAR',       'SHL',       'SHR',       'SBB',
  176.         'SCAS',      'SCASB',     'SCASW',     'STC',       'STD',
  177.         'STI',       'STOS',      'STOSB',     'STOSW',     'SUB',
  178.         'TEST',      'WAIT',      'XCHG',      'XLAT',      'XLATB',
  179.         'XOR');
  180.  
  181.     KeywordTokens: ARRAY [1..NoOfKeywords] OF INTEGER = (
  182.         _LOCK_,      _REP_,       _REPE_,      _REPZ_,      _REPNE_,
  183.         _REPNZ_,     _SEGCS_,     _SEGDS_,     _SEGES_,     _SEGSS_,
  184.         _DB_,        _DW_,        _DD_,        _AH_,        _DH_,
  185.         _DX_,        _OR_,        _ST_,        _AL_,        _CL_,
  186.         _ES_,        _PTR_,       _TBYTE_,     _AND_,       _CS_,
  187.         _FAR_,       _QWORD_,     _TYPE_,      _AX_,        _CX_,
  188.         _HIGH_,      _SEG_,       _WORD_,      _BH_,        _DH_,
  189.         _LOW_,       _SHL_,       _XOR_,       _BL_,        _DI_,
  190.         _MOD_,       _SHR_,       _BP_,        _DL_,        _NEAR_,
  191.         _SI_,        _BX_,        _DS_,        _NOT_,       _SP_,
  192.         _BYTE_,      _DWORD_,     _OFFSET_,    _SS_,        _CODE_,
  193.         _DATA_,      _RESULT_,    _AAA_,       _AAD_,       _AAM_,
  194.         _AAS_,       _ADC_,       _ADD_,       _AND_,       _BOUND_,
  195.         _CALL_,      _CBW_,       _CDQ_,       _CLC_,       _CLD_,
  196.         _CLI_,       _CMC_,       _CMP_,       _CMPS_,      _CMPSB_,
  197.         _CMPSW_,     _DAA_,       _DAS_,       _DEC_,       _DIV_,
  198.         _ENTER_,     _HLT_,       _IDIV_,      _IMUL_,      _IN_,
  199.         _INC_,       _INS_,       _INSB_,      _INSW_,      _INT_,
  200.         _INTO_,      _IRET_,      _JA_,        _JAE_,       _JB_,
  201.         _JBE_,       _JC_,        _JCXZ_,      _JE_,        _JZ_,
  202.         _JG_,        _JGE_,       _JL_,        _JLE_,       _JNA_,
  203.         _JNAE_,      _JNB_,       _JNBE_,      _JNC_,       _JNE_,
  204.         _JNG_,       _JNGE_,      _JNL_,       _JNLE_,      _JNO_,
  205.         _JNP_,       _JNS_,       _JNZ_,       _JO_,        _JP_,
  206.         _JPE_,       _JPO_,       _JS_,        _JZ_,        _JMP_,
  207.         _LAHF_,      _LEA_,       _LEAVE_,     _LOCK_,      _LODS_,
  208.         _LODSB_,     _LODSW_,     _LOOP_,      _LOOPE_,     _LOOPZ_,
  209.         _LOOPNE_,    _LOOPNZ_,    _MOV_,       _MOVS_,      _MOVSB_,
  210.         _MOVSW_,     _MUL_,       _NEG_,       _NOP_,       _NOT_,
  211.         _OR_,        _OUT_,       _OUTS_,      _OUTSB_,     _OUTSW_,
  212.         _POP_,       _POPF_,      _PUSH_,      _PUSHF_,     _RCL_,
  213.         _RCR_,       _ROL_,       _ROR_,       _RET_,       _SAHF_,
  214.         _SAL_,       _SAR_,       _SHL_,       _SHR_,       _SBB_,
  215.         _SCAS_,      _SCASB_,     _SCASW_,     _STC_,       _STD_,
  216.         _STI_,       _STOS_,      _STOSB_,     _STOSW_,     _SUB_,
  217.         _TEST_,      _WAIT_,      _XCHG_,      _XLAT_,      _XLATB_,
  218.         _XOR_);
  219.  
  220.   VAR m, n, k: INTEGER;
  221.  
  222.   BEGIN
  223.     id := Upper (id);
  224.     m := 1; n := NoOfKeywords;
  225.     WHILE m <= n DO BEGIN
  226.       k := m + (n-m) DIV 2;
  227.       IF id = KeyWords [k] THEN BEGIN
  228.         isAssemblerKeyword := TRUE;
  229.         Token := KeywordTokens [k];
  230.         Exit;
  231.       END ELSE
  232.         IF id > Keywords [k] THEN
  233.           m := k+1
  234.         ELSE
  235.           n := k-1
  236.       END;
  237.     isAssemblerKeyword := FALSE;
  238.   END;
  239.  
  240. %}
  241.  
  242. %Start Normal
  243. %Start Comment
  244. %Start String1
  245. %Start String2
  246. %Start asmString1
  247. %Start asmString2
  248. %Start asmState
  249. %Start asmComment
  250.  
  251. letter                          [A-Za-z_]
  252. digit                           [0-9]
  253. hexdigit                        [0-9A-Fa-f]
  254. identifier                      {letter}({letter}|{digit})*
  255. integer                         ({digit}+|\${hexdigit}+)
  256. sign                            [\+\-]
  257. exp                             [Ee]{sign}?{digit}+
  258. real                            {digit}+(\.{digit}+)?{exp}?
  259. special                         [\+\-*/=<>,():;@\^\[\]"."]
  260. white                           [\1-\40]
  261. eof                             \0
  262.  
  263. asmLabel                        @+(@|{letter}|{digit})*
  264. asmBinary                       [01]+[Bb]
  265. asmOctal                        [0-7]+[Oo]
  266. asmHex                          {digit}{hexdigit}+[Hh]
  267. asmWhite                        [\1-\11\13-\40]
  268. asmSpecial                      ({special}|&)
  269. %%
  270.   VAR
  271.     Result:  INTEGER;
  272.     EndText: STRING [2];
  273.     c:       CHAR;
  274.     KW:      INTEGER;
  275.     s:       STRING;
  276.     i:       INTEGER;
  277.     cs:      STRING [2];
  278.  
  279. <Normal>'
  280.           BEGIN
  281.             s := '';
  282.             Start (String2);
  283.           END;
  284. <Normal>#
  285.           BEGIN
  286.             s := '';
  287.             Start (String1);
  288.             Unget_Char (yyText [1]);
  289.           END;
  290.  
  291. <String1>'
  292.           Start (String2);
  293. <String1>#{integer}
  294.           BEGIN   { #123 oder #$12 im String enthalten }
  295.             Delete (yyText, 1, 1);
  296.             Val (yyText, i, Result);
  297.             IF Result = 0 THEN
  298.               s := s + Char (i)
  299.             ELSE
  300.               Write (' Error in integer constant ');
  301.           END;
  302. <String1>.
  303.           BEGIN
  304.             Start (Normal);
  305.             Return (STRING_CONST);
  306.             UnGet_Char (yytext [1]);
  307.             Write (''''+s+'''');
  308.           END;
  309.  
  310. <String2>"''"
  311.           s := s+'''';
  312. <String2>'
  313.           Start (String1);
  314.  
  315. <asmState>'
  316.           BEGIN
  317.             Start (asmString1); s := '';
  318.           END;
  319. <asmString1>"''"
  320.           s := s+'''';
  321. <asmString1>'
  322.           BEGIN
  323.             Start (asmState);
  324.             Return (STRING_CONST);
  325.             Write (''''+s+'''');
  326.           END;
  327.  
  328. <asmState>\"
  329.           BEGIN
  330.             Start (asmString2); s := '';
  331.           END;
  332. <asmString2>""""
  333.           s := s+'"';
  334. <asmString2>\"
  335.           BEGIN
  336.             Start (asmState);
  337.             Return (STRING_CONST);
  338.             Write ('"'+s+'"');
  339.           END;
  340.  
  341. <String2,asmString1,asmString2>\n
  342.           BEGIN
  343.             Writeln ('String exceeds line');  Halt;
  344.           END;
  345. <String2,asmString1,asmString2>.
  346.           s := s + yyText;
  347.  
  348.  
  349.  
  350. <Normal>"(*"|"{"
  351.           BEGIN
  352.             cs := yyText;
  353.             Write (yyText);
  354.             Start (Comment);
  355.           END;
  356. <Comment>"*)"|"}"
  357.           BEGIN
  358.             IF ((yyText = '}') AND (cs = '{')) OR
  359.                ((yyText = '*)') AND (cs = '(*')) THEN BEGIN
  360.               Write (yyText);
  361.               Start (Normal);
  362.             END;
  363.           END;
  364. <asmState>"(*"|"{"
  365.           BEGIN
  366.             Write (yyText);
  367.             Start (asmComment);
  368.           END;
  369. <asmComment>"*)"|"}"
  370.           BEGIN
  371.             IF ((yyText = '}') AND (cs = '{')) OR
  372.                ((yyText = '*)') AND (cs = '(*')) THEN BEGIN
  373.               Write (yyText);
  374.               Start (asmState);
  375.               Return (ASM_Comment);
  376.             END;
  377.           END;
  378. <asmComment,Comment>\0
  379.           BEGIN
  380.             Start (Normal);
  381.             CommentEof;
  382.           END;
  383. <asmComment,Comment>.
  384.           Write (yyText);
  385.  
  386.  
  387.  
  388. <asmState>{identifier}
  389.           BEGIN
  390.             Write (yyText);
  391.             IF isAssemblerKeyword (yyText, KW) THEN
  392.               Return (KW)
  393.             ELSE
  394.               Return (ID);
  395.             IF Upper (yyText) = 'END' THEN
  396.               Start (Normal);
  397.           END;
  398. <asmState>{asmLabel}
  399.           BEGIN
  400.             Return (ASM_LABEL);
  401.             Write (yytext);
  402.           END;
  403. <asmState>{asmBinary}
  404.           BEGIN
  405.             Write (yyText);
  406.             Dec (Byte (yyText [0]));
  407.             MakeInt (yyText, BinBase);
  408.           END;
  409. <asmState>{asmOctal}
  410.           BEGIN
  411.             Write (yyText);
  412.             Dec (Byte (yyText [0]));
  413.             MakeInt (yyText, OctBase);
  414.           END;
  415. <asmState>{asmHex}
  416.           BEGIN
  417.             Write (yyText);
  418.             Dec (Byte (yyText [0]));
  419.             MakeInt (yyText, HexBase);
  420.           END;
  421. <asmState>\n
  422.           BEGIN
  423.             Writeln;
  424.             Return (ASM_SEPERATOR);
  425.           END;
  426. <asmState>;
  427.           BEGIN
  428.             Write (';');
  429.             Return (ASM_SEPERATOR);
  430.           END;
  431. <asmState>{asmWhite}
  432.           Write (yyText);
  433. <asmState>{asmSpecial}
  434.           BEGIN
  435.             ReturnC (yyText [1]);
  436.             Write (yyText);
  437.           END;
  438. <asmState,Normal>{integer}
  439.           BEGIN
  440.             Val (yyText, yylVal.yyInteger, Result);
  441.             Write (yyText);
  442.             IF Result=0 THEN
  443.               Return (UNSIGNED_INTEGER)
  444.             ELSE
  445.               Return (ILLEGAL);
  446.           END;
  447. <asmState>.
  448.           BEGIN
  449.             Write ('Illegal character: ', yyText);
  450.             Return (ILLEGAL);
  451.           END;
  452.  
  453.  
  454.  
  455.  
  456. <Normal>{real}
  457.           BEGIN
  458.             Val (yyText, yylVal.yyReal, Result);
  459.             Write (yyText);
  460.             IF Result=0 THEN
  461.               Return (UNSIGNED_REAL)
  462.             ELSE
  463.               Return (ILLEGAL);
  464.           END;
  465. <Normal>{identifier}
  466.           BEGIN
  467.             Write (yyText);
  468.             IF isKeyword (yyText, KW) THEN
  469.               Return (KW)
  470.             ELSE
  471.               Return (ID);
  472.             IF Upper (yyText) = 'ASM' THEN
  473.               Start (asmState);
  474.           END;
  475. <Normal>".."
  476.           BEGIN
  477.             Write (yyText);
  478.             Return (DOTDOT);
  479.           END;
  480. <Normal>":="
  481.           BEGIN
  482.             Write (yyText);
  483.             Return (DEFEQ);
  484.           END;
  485. <Normal>"<="
  486.           BEGIN
  487.             Write (yyText);
  488.             Return (LEQ);
  489.           END;
  490. <Normal>"<>"
  491.           BEGIN
  492.             Write (yyText);
  493.             Return (NEQ);
  494.           END;
  495. <Normal>">="
  496.           BEGIN
  497.             Write (yyText);
  498.             Return (GEQ);
  499.           END;
  500. <Normal>"(."
  501.           BEGIN
  502.             Write (yyText);
  503.             yyText := '[';
  504.             ReturnC ('[');
  505.           END;
  506. <Normal>".)"
  507.           BEGIN
  508.             Write (yyText);
  509.             yyText := ']';
  510.             ReturnC (']');
  511.           END;
  512. <Normal>{eof}
  513.           BEGIN
  514.             Write (yyText);
  515.             Return (0);
  516.           END;
  517. <Normal>{white}
  518.           BEGIN
  519.             IF yyText = #10 THEN
  520.               Writeln
  521.             ELSE
  522.               Write (yyText);
  523.           END;
  524. <Normal>{special}
  525.           BEGIN
  526.             ReturnC (yyText [1]);
  527.             Write (yyText);
  528.           END;
  529. <Normal>.
  530.           BEGIN
  531.             Write ('Illegal character: ', yyText);
  532.             Return (ILLEGAL);
  533.           END;
  534.  
  535.