+ idtoken and only one token table

compiler/parser.pas

@@ -98,6 +98,7 @@ unit parser;
     procedure compile(const filename:string;compile_system:boolean);
       var
        { scanner }
+         oldidtoken,
          oldtoken       : ttoken;
          oldtokenpos    : tfileposinfo;
          oldc           : char;
@@ -155,6 +156,7 @@ unit parser;
          oldpattern:=pattern;
          oldorgpattern:=orgpattern;
          oldtoken:=token;
+         oldidtoken:=idtoken;
          old_block_type:=block_type;
          oldtokenpos:=tokenpos;
          oldcurrent_scanner:=current_scanner;
@@ -235,7 +237,7 @@ unit parser;
 
        { startup scanner }
          current_scanner:=new(pscannerfile,Init(filename));
-         token:=current_scanner^.yylex;
+         current_scanner^.readtoken;
 
        { init code generator for a new module }
          codegen_newmodule;
@@ -302,6 +304,7 @@ unit parser;
               pattern:=oldpattern;
               orgpattern:=oldorgpattern;
               token:=oldtoken;
+              idtoken:=oldidtoken;
               tokenpos:=oldtokenpos;
               block_type:=old_block_type;
               current_scanner:=oldcurrent_scanner;
@@ -371,7 +374,10 @@ unit parser;
 end.
 {
   $Log$
-  Revision 1.50  1998-09-24 23:49:08  peter
+  Revision 1.51  1998-09-26 17:45:30  peter
+    + idtoken and only one token table
+
+  Revision 1.50  1998/09/24 23:49:08  peter
     + aktmodeswitches
 
   Revision 1.49  1998/09/23 15:39:07  pierre

compiler/pbase.pas

@@ -42,9 +42,6 @@ unit pbase;
 
 
     var
-       { contains the current token to be processes }
-       token : ttoken;
-
        { size of data segment, set by proc_unit or proc_program }
        datasize : longint;
 
@@ -65,12 +62,12 @@ unit pbase;
        ignore_equal : boolean;
 
 
+    function tokenstring(i : ttoken):string;
+
     { consumes token i, if the current token is unequal i }
     { a syntax error is written                           }
     procedure consume(i : ttoken);
 
-    function tokenstring(i : ttoken) : string;
-
     { consumes all tokens til atoken (for error recovering }
     procedure consume_all_until(atoken : ttoken);
 
@@ -94,57 +91,37 @@ unit pbase;
     uses
        files,scanner,systems,verbose;
 
-      { ttoken = (PLUS,MINUS,STAR,SLASH,EQUAL,GT,
-                 LT,LTE,GTE,SYMDIF,STARSTAR,ASSIGNMENT,CARET,
-                 LECKKLAMMER,RECKKLAMMER,
-                 POINT,COMMA,LKLAMMER,RKLAMMER,COLON,SEMICOLON,
-                 KLAMMERAFFE,UNEQUAL,POINTPOINT,
-                 ID,REALNUMBER,_EOF,INTCONST,CSTRING,CCHAR,DOUBLEADDR,}
-      const tokens : array[PLUS..DOUBLEADDR] of string[12] = (
-                 '+','-','*','/','=','>','<','>=','<=','is','as','in',
-                 '><','**',':=','^','<>','[',']','.',',','(',')',':',';',
-                 '@','..',
-                 'identifier','const real.','end of file',
-                 'ord const','const string','const char','@@');
-
-    function tokenstring(i : ttoken) : string;
-      var
-        j : longint;
+    function tokenstring(i : ttoken):string;
       begin
-         if i<_AND then
-           tokenstring:=tokens[i]
-         else
-           begin
-             for j:=1 to anz_keywords do
-              if keyword_token[j]=i then
-               tokenstring:=keyword[j];
-           end;
+        tokenstring:=tokens[i].str;
       end;
 
-
     { consumes token i, write error if token is different }
     procedure consume(i : ttoken);
       begin
-        if token<>i then
-          Message1(scan_f_syn_expected,tokenstring(i))
+        if (token<>i) and (idtoken<>i) then
+          Message2(scan_f_syn_expected,tokens[i].str,tokens[token].str)
         else
           begin
             if token=_END then
               last_endtoken_filepos:=tokenpos;
-            token:=current_scanner^.yylex;
+            current_scanner^.readtoken;
           end;
       end;
 
 
     procedure consume_all_until(atoken : ttoken);
       begin
-         while (token<>atoken) and (token<>_EOF) do
-           consume(token);
-         { this will create an error if the token is _EOF }
-         if token<>atoken then
-           consume(atoken);
-         { this error is fatal as we have read the whole file }
-         Message(scan_f_end_of_file);
+         while (token<>atoken) and (idtoken<>atoken) do
+          begin
+            Consume(token);
+            if token=_EOF then
+             begin
+               Consume(atoken);
+               Message(scan_f_end_of_file);
+               exit;
+             end;
+          end;
       end;
 
 
@@ -203,7 +180,10 @@ end.
 
 {
   $Log$
-  Revision 1.16  1998-09-23 15:39:08  pierre
+  Revision 1.17  1998-09-26 17:45:31  peter
+    + idtoken and only one token table
+
+  Revision 1.16  1998/09/23 15:39:08  pierre
     * browser bugfixes
       was adding a reference when looking for the symbol
       if -bSYM_NAME was used

compiler/pdecl.pas

@@ -235,9 +235,7 @@ unit pdecl;
           consume(ID);
        { read vars }
          while (token=ID) and
-           not(is_object and
-              ((pattern='PUBLIC') or (pattern='PRIVATE') or
-               (pattern='PUBLISHED') or (pattern='PROTECTED'))) do
+               not(is_object and (idtoken in [_PUBLIC,_PRIVATE,_PUBLISHED,_PROTECTED])) do
            begin
              C_name:=orgpattern;
              sc:=idlist;
@@ -267,10 +265,10 @@ unit pdecl;
                   symdone:=true;
                end;
            { check for absolute }
-             if not symdone and (token=ID) and
-                (pattern='ABSOLUTE') and not(is_record or is_object) then
+             if not symdone and
+                (idtoken=_ABSOLUTE) and not(is_record or is_object) then
               begin
-                consume(ID);
+                consume(_ABSOLUTE);
               { only allowed for one var }
                 s:=sc^.get_with_tokeninfo(declarepos);
                 if not sc^.empty then
@@ -347,6 +345,7 @@ unit pdecl;
              { for a record there doesn't need to be a ; before the END or ) }
              if not((is_record or is_object) and (token in [_END,RKLAMMER])) then
                consume(SEMICOLON);
+             { procvar handling }
              if (p^.deftype=procvardef) and (p^.sym=nil) then
                begin
                   newtype:=new(ptypesym,init('unnamed',p));
@@ -361,10 +360,7 @@ unit pdecl;
                 { Check for C Variable declarations }
                 if (cs_support_c_var in aktmoduleswitches) and
                    not(is_record or is_object) and
-                   ((pattern='EXPORT') or
-                    (pattern='EXTERNAL') or
-                    (pattern='PUBLIC') or
-                    (pattern='CVAR')) then
+                   (idtoken in [_EXPORT,_EXTERNAL,_PUBLIC,_CVAR]) then
                  begin
                    { only allowed for one var }
                    s:=sc^.get_with_tokeninfo(declarepos);
@@ -376,21 +372,21 @@ unit pdecl;
                    extern_csym:=false;
                    export_Csym:=false;
                    { cdecl }
-                   if pattern='CVAR' then
+                   if idtoken=_CVAR then
                     begin
-                      consume(ID);
+                      consume(_CVAR);
                       consume(SEMICOLON);
                       is_cdecl:=true;
                       C_name:=target_os.Cprefix+C_name;
                     end;
                    { external }
-                   if pattern='EXTERNAL' then
+                   if idtoken=_EXTERNAL then
                     begin
-                      consume(ID);
+                      consume(_EXTERNAL);
                       extern_csym:=true;
                     end;
                    { export }
-                   if (pattern='EXPORT') or (pattern='PUBLIC') then
+                   if idtoken in [_EXPORT,_PUBLIC] then
                     begin
                       consume(ID);
                       if extern_csym then
@@ -401,10 +397,7 @@ unit pdecl;
                  { external and export need a name after when no cdecl is used }
                    if not is_cdecl then
                     begin
-                      if (token=ID) and (pattern='NAME') then
-                       consume(ID)
-                      else
-                       Message(parser_e_name_keyword_expected);
+                      consume(_NAME);
                       C_name:=pattern;
                     { allow also char }
                       if token=CCHAR then
@@ -432,12 +425,12 @@ unit pdecl;
                    symdone:=true;
                  end
                 else
-                 if (is_object) and (cs_static_keyword in aktglobalswitches) and (pattern='STATIC') then
+                 if (is_object) and (cs_static_keyword in aktglobalswitches) and (idtoken=_STATIC) then
                   begin
                     current_object_option:=current_object_option or sp_static;
                     insert_syms(symtablestack,sc,p);
                     current_object_option:=current_object_option - sp_static;
-                    consume(ID);
+                    consume(_STATIC);
                     consume(SEMICOLON);
                     symdone:=true;
                   end;
@@ -807,9 +800,9 @@ unit pdecl;
                   begin
                      consume(COLON);
                      p^.proptype:=single_type(hs);
-                     if (token=ID) and (pattern='INDEX') then
+                     if (idtoken=_INDEX) then
                        begin
-                          consume(ID);
+                          consume(_INDEX);
                           p^.options:=p^.options or ppo_indexed;
                           if token=INTCONST then
                             val(pattern,p^.index,code);
@@ -857,9 +850,9 @@ unit pdecl;
                 datacoll^.data:=p^.proptype;
                 datacoll^.next:=nil;
 
-                if (token=ID) and (pattern='READ') then
+                if (idtoken=_READ) then
                   begin
-                     consume(ID);
+                     consume(_READ);
                      sym:=search_class_member(aktclass,pattern);
                      if not(assigned(sym)) then
                        Message1(sym_e_unknown_id,pattern)
@@ -894,9 +887,9 @@ unit pdecl;
                        end;
                      consume(ID);
                   end;
-                if (token=ID) and (pattern='WRITE') then
+                if (idtoken=_WRITE) then
                   begin
-                     consume(ID);
+                     consume(_WRITE);
                      sym:=search_class_member(aktclass,pattern);
                      if not(assigned(sym)) then
                        Message1(sym_e_unknown_id,pattern)
@@ -929,14 +922,14 @@ unit pdecl;
                        end;
                      consume(ID);
                   end;
-                if (token=ID) and (pattern='STORED') then
+                if (idtoken=_STORED) then
                   begin
-                     consume(ID);
+                     consume(_STORED);
                      { !!!!!!!! }
                   end;
-                if (token=ID) and (pattern='DEFAULT') then
+                if (idtoken=_DEFAULT) then
                   begin
-                     consume(ID);
+                     consume(_DEFAULT);
                      if not(is_ordinal(p^.proptype) or
                        ((p^.proptype^.deftype=setdef) and
                         (psetdef(p^.proptype)^.settype=smallset)
@@ -956,17 +949,17 @@ unit pdecl;
                        p^.default:=pt^.value;
                      disposetree(pt);
                   end
-                else if (token=ID) and (pattern='NODEFAULT') then
+                else if (idtoken=_NODEFAULT) then
                   begin
-                     consume(ID);
+                     consume(_NODEFAULT);
                      p^.default:=0;
                   end;
                 symtablestack^.insert(p);
                 { default property ? }
                 consume(SEMICOLON);
-                if (token=ID) and (pattern='DEFAULT') then
+                if (idtoken=_DEFAULT) then
                   begin
-                     consume(ID);
+                     consume(_DEFAULT);
                      p2:=search_default_property(aktclass);
                      if assigned(p2) then
                        message1(parser_e_only_one_default_property,
@@ -1218,37 +1211,32 @@ unit pdecl;
                 aktclass^.options:=aktclass^.options or oo_hasprotected;
               case token of
                ID : begin
-                      if (pattern='PRIVATE') then
-                       begin
-                         consume(ID);
-                         actmembertype:=sp_private;
-                         current_object_option:=sp_private;
-                       end
-                      else
-                       if (pattern='PROTECTED') then
-                        begin
-                          consume(ID);
-                          current_object_option:=sp_protected;
-                          actmembertype:=sp_protected;
-                        end
-                      else
-                       if (pattern='PUBLIC') then
-                        begin
-                          consume(ID);
-                          current_object_option:=sp_public;
-                          actmembertype:=sp_public;
-                        end
-                      else
-                       if (pattern='PUBLISHED') then
-                        begin
-                          if (aktclass^.options and oo_can_have_published)=0 then
-                           Message(parser_e_cant_have_published);
-                          consume(ID);
-                          current_object_option:=sp_published;
-                          actmembertype:=sp_published;
-                        end
+                      case idtoken of
+                       _PRIVATE : begin
+                                    consume(_PRIVATE);
+                                    actmembertype:=sp_private;
+                                    current_object_option:=sp_private;
+                                  end;
+                     _PROTECTED : begin
+                                    consume(_PROTECTED);
+                                    current_object_option:=sp_protected;
+                                    actmembertype:=sp_protected;
+                                  end;
+                        _PUBLIC : begin
+                                    consume(_PUBLIC);
+                                    current_object_option:=sp_public;
+                                    actmembertype:=sp_public;
+                                  end;
+                     _PUBLISHED : begin
+                                    if (aktclass^.options and oo_can_have_published)=0 then
+                                     Message(parser_e_cant_have_published);
+                                    consume(_PUBLISHED);
+                                    current_object_option:=sp_published;
+                                    actmembertype:=sp_published;
+                                  end;
                       else
-                       read_var_decs(false,true);
+                        read_var_decs(false,true);
+                      end;
                     end;
         _PROPERTY : property_dec;
        _PROCEDURE,
@@ -1258,44 +1246,39 @@ unit pdecl;
                       parse_only:=true;
                       proc_head;
                       parse_only:=oldparse_only;
-                      if (token=ID) then
+                      case idtoken of
+                       _DYNAMIC,
+                       _VIRTUAL : begin
+                                    if actmembertype=sp_private then
+                                      Message(parser_w_priv_meth_not_virtual);
+                                    consume(idtoken);
+                                    consume(SEMICOLON);
+                                    aktprocsym^.definition^.options:=aktprocsym^.definition^.options or povirtualmethod;
+                                    aktclass^.options:=aktclass^.options or oo_hasvirtual;
+                                  end;
+                      _OVERRIDE : begin
+                                    consume(_OVERRIDE);
+                                    consume(SEMICOLON);
+                                    aktprocsym^.definition^.options:=aktprocsym^.definition^.options or
+                                      pooverridingmethod or povirtualmethod;
+                                  end;
+                      _ABSTRACT : begin
+                                    if (aktprocsym^.definition^.options and povirtualmethod)<>0 then
+                                      aktprocsym^.definition^.options:=aktprocsym^.definition^.options or poabstractmethod
+                                    else
+                                      Message(parser_e_only_virtual_methods_abstract);
+                                    consume(_ABSTRACT);
+                                    consume(SEMICOLON);
+                                    { the method is defined }
+                                    aktprocsym^.definition^.forwarddef:=false;
+                                  end;
+                      end;
+                      if (cs_static_keyword in aktglobalswitches) and (idtoken=_STATIC) then
                        begin
-                         if (pattern='VIRTUAL') or (pattern='DYNAMIC') then
-                          begin
-                            if actmembertype=sp_private then
-                             Message(parser_w_priv_meth_not_virtual);
-                            consume(ID);
-                            consume(SEMICOLON);
-                            aktprocsym^.definition^.options:=aktprocsym^.definition^.options or povirtualmethod;
-                            aktclass^.options:=aktclass^.options or oo_hasvirtual;
-                          end
-                         else
-                          if (pattern='OVERRIDE') then
-                           begin
-                             consume(ID);
-                             consume(SEMICOLON);
-                             aktprocsym^.definition^.options:=aktprocsym^.definition^.options or
-                               pooverridingmethod or povirtualmethod;
-                           end;
-                      { Delphi II extension }
-                         if (pattern='ABSTRACT') then
-                          begin
-                            consume(ID);
-                            consume(SEMICOLON);
-                            if (aktprocsym^.definition^.options and povirtualmethod)<>0 then
-                             aktprocsym^.definition^.options:=aktprocsym^.definition^.options or poabstractmethod
-                            else
-                             Message(parser_e_only_virtual_methods_abstract);
-                          { the method is defined }
-                            aktprocsym^.definition^.forwarddef:=false;
-                          end;
-                         if (cs_static_keyword in aktglobalswitches) and (pattern='STATIC') then
-                          begin
-                            consume(ID);
-                            consume(SEMICOLON);
-                            aktprocsym^.properties:=aktprocsym^.properties or sp_static;
-                            aktprocsym^.definition^.options:=aktprocsym^.definition^.options or postaticmethod;
-                          end;
+                         consume(_STATIC);
+                         consume(SEMICOLON);
+                         aktprocsym^.properties:=aktprocsym^.properties or sp_static;
+                         aktprocsym^.definition^.options:=aktprocsym^.definition^.options or postaticmethod;
                        end;
                     end;
      _CONSTRUCTOR : begin
@@ -1305,61 +1288,55 @@ unit pdecl;
                       parse_only:=true;
                       constructor_head;
                       parse_only:=oldparse_only;
-                      if (token=ID) then
-                       begin
-                         if (pattern='VIRTUAL') or (pattern='DYNAMIC') then
-                          begin
-                            consume(ID);
-                            consume(SEMICOLON);
-                            if not(aktclass^.isclass) then
-                             Message(parser_e_constructor_cannot_be_not_virtual)
-                            else
-                             begin
-                               aktprocsym^.definition^.options:=aktprocsym^.definition^.options or povirtualmethod;
-                               aktclass^.options:=aktclass^.options or oo_hasvirtual;
-                             end;
-                          end
-                         else
-                          if (pattern='OVERRIDE') then
-                           begin
-                             consume(ID);
-                             consume(SEMICOLON);
-                             if (aktclass^.options and oois_class=0) then
-                              Message(parser_e_constructor_cannot_be_not_virtual)
-                             else
-                              aktprocsym^.definition^.options:=aktprocsym^.definition^.options or
-                                pooverridingmethod or povirtualmethod;
-                          end;
-                       end;
+                      case idtoken of
+                       _DYNAMIC,
+                       _VIRTUAL : begin
+                                    if not(aktclass^.isclass) then
+                                     Message(parser_e_constructor_cannot_be_not_virtual)
+                                    else
+                                     begin
+                                       aktprocsym^.definition^.options:=aktprocsym^.definition^.options or povirtualmethod;
+                                       aktclass^.options:=aktclass^.options or oo_hasvirtual;
+                                     end;
+                                    consume(idtoken);
+                                    consume(SEMICOLON);
+                                  end;
+                      _OVERRIDE : begin
+                                    if (aktclass^.options and oois_class=0) then
+                                      Message(parser_e_constructor_cannot_be_not_virtual)
+                                    else
+                                      aktprocsym^.definition^.options:=aktprocsym^.definition^.options or
+                                        pooverridingmethod or povirtualmethod;
+                                    consume(_OVERRIDE);
+                                    consume(SEMICOLON);
+                                  end;
+                      end;
                     end;
       _DESTRUCTOR : begin
                       if there_is_a_destructor then
-                       Message(parser_n_only_one_destructor);
+                        Message(parser_n_only_one_destructor);
                       there_is_a_destructor:=true;
                       if actmembertype<>sp_public then
-                       Message(parser_w_destructor_should_be_public);
+                        Message(parser_w_destructor_should_be_public);
                       oldparse_only:=parse_only;
                       parse_only:=true;
                       destructor_head;
                       parse_only:=oldparse_only;
-                      if (token=ID) then
-                       begin
-                         if (pattern='VIRTUAL') or (pattern='DYNAMIC') then
-                          begin
-                            consume(ID);
-                            consume(SEMICOLON);
-                            aktprocsym^.definition^.options:=aktprocsym^.definition^.options or povirtualmethod;
-                            aktclass^.options:=aktclass^.options or oo_hasvirtual;
-                          end
-                         else
-                          if (pattern='OVERRIDE') then
-                           begin
-                             consume(ID);
-                             consume(SEMICOLON);
-                             aktprocsym^.definition^.options:=aktprocsym^.definition^.options or
-                               pooverridingmethod or povirtualmethod;
-                           end;
-                       end;
+                      case idtoken of
+                       _DYNAMIC,
+                       _VIRTUAL : begin
+                                    consume(idtoken);
+                                    consume(SEMICOLON);
+                                    aktprocsym^.definition^.options:=aktprocsym^.definition^.options or povirtualmethod;
+                                    aktclass^.options:=aktclass^.options or oo_hasvirtual;
+                                  end;
+                      _OVERRIDE : begin
+                                    consume(_OVERRIDE);
+                                    consume(SEMICOLON);
+                                    aktprocsym^.definition^.options:=aktprocsym^.definition^.options or
+                                      pooverridingmethod or povirtualmethod;
+                                  end;
+                      end;
                     end;
              _END : begin
                       consume(_END);
@@ -2059,7 +2036,10 @@ unit pdecl;
 end.
 {
   $Log$
-  Revision 1.58  1998-09-25 00:04:01  florian
+  Revision 1.59  1998-09-26 17:45:33  peter
+    + idtoken and only one token table
+
+  Revision 1.58  1998/09/25 00:04:01  florian
     * problems when calling class methods fixed
 
   Revision 1.57  1998/09/24 23:49:09  peter

compiler/pexports.pas

@@ -86,21 +86,21 @@ unit pexports;
                         if (srsym^.typ<>procsym) or
                           ((pprocdef(pprocsym(srsym)^.definition)^.options and poexports)=0) then
                           Message(parser_e_illegal_symbol_exported);
-                        if (token=ID) and (pattern='INDEX') then
+                        if (idtoken=_INDEX) then
                           begin
-                             consume(ID);
+                             consume(_INDEX);
                              val(pattern,hp^.index,code);
                              consume(INTCONST);
                           end;
-                        if (token=ID) and (pattern='NAME') then
+                        if (idtoken=_NAME) then
                           begin
-                             consume(ID);
+                             consume(_NAME);
                              hp^.name:=stringdup(pattern);
                              consume(ID);
                           end;
-                        if (token=ID) and (pattern='RESIDENT') then
+                        if (idtoken=_RESIDENT) then
                           begin
-                             consume(ID);
+                             consume(_RESIDENT);
                              hp^.options:=hp^.options or eo_resident;
                           end;
                      end;
@@ -123,39 +123,7 @@ end.
 
 {
   $Log$
-  Revision 1.1  1998-03-25 11:18:15  root
-  Initial revision
-
-  Revision 1.7  1998/03/10 01:17:24  peter
-    * all files have the same header
-    * messages are fully implemented, EXTDEBUG uses Comment()
-    + AG... files for the Assembler generation
-
-  Revision 1.6  1998/03/06 00:52:42  peter
-    * replaced all old messages from errore.msg, only ExtDebug and some
-      Comment() calls are left
-    * fixed options.pas
-
-  Revision 1.5  1998/03/02 01:49:01  peter
-    * renamed target_DOS to target_GO32V1
-    + new verbose system, merged old errors and verbose units into one new
-      verbose.pas, so errors.pas is obsolete
-
-  Revision 1.4  1998/02/13 10:35:24  daniel
-  * Made Motorola version compilable.
-  * Fixed optimizer
-
-  Revision 1.3  1998/01/12 13:02:41  florian
-    + items of exports are now seperated by ,
-
-  Revision 1.2  1998/01/12 12:11:35  florian
-    + unit qualifier is now allowed to specify exported symbols
-    + exports starts now a list of symbols to export
-
-  Revision 1.1  1998/01/11 10:58:07  florian
-    + pexports in lowercase commited
-
-  Revision 1.1  1998/01/11 10:54:19  florian
-    + generic library support
+  Revision 1.2  1998-09-26 17:45:35  peter
+    + idtoken and only one token table
 
 }

compiler/pexpr.pas

@@ -1544,79 +1544,92 @@ unit pexpr;
 
     type
       Toperator_precedence=(opcompare,opaddition,opmultiply);
+      Ttok2nodeRec=record
+        tok : ttoken;
+        nod : ttreetyp;
+      end;
 
     const
-      tok2node:array[PLUS.._XOR] of Ttreetyp=
-                    (addn,subn,muln,slashn,equaln,gtn,ltn,gten,lten,
-                     isn,asn,inn,
-                     symdifn,starstarn,nothingn,caretn,unequaln,nothingn,
-                     nothingn,nothingn,nothingn,nothingn,nothingn,
-                     nothingn,nothingn,nothingn,nothingn,nothingn,
-                     nothingn,nothingn,nothingn,nothingn,nothingn,
-                     nothingn,andn,nothingn,nothingn,nothingn,
-                     nothingn,nothingn,nothingn,nothingn,nothingn,
-                     nothingn,nothingn,divn,nothingn,nothingn,
-                     nothingn,nothingn,nothingn,nothingn,nothingn,
-                     nothingn,nothingn,nothingn,nothingn,nothingn,
-                     nothingn,nothingn,nothingn,nothingn,nothingn,
-                     modn,nothingn,nothingn,nothingn,nothingn,
-                     nothingn,nothingn,orn,
-                     nothingn,nothingn,nothingn,nothingn,nothingn,
-                     nothingn,nothingn,shln,shrn,
-                     nothingn,nothingn,nothingn,nothingn,nothingn,
-                     nothingn,nothingn,nothingn,nothingn,nothingn,
-                     nothingn,xorn);
-            operator_levels:array[Toperator_precedence] of set of Ttoken=
-                    ([LT,LTE,GT,GTE,EQUAL,UNEQUAL,_IN,_IS],
-                     [PLUS,MINUS,_OR,_XOR],
-                     [CARET,SYMDIF,STARSTAR,STAR,SLASH,_DIV,_MOD,_AND,_SHL,_SHR,_AS]);
+      tok2nodes=23;
+      tok2node:array[1..tok2nodes] of ttok2noderec=(
+        (tok:PLUS    ;nod:addn),
+        (tok:MINUS   ;nod:subn),
+        (tok:STAR    ;nod:muln),
+        (tok:SLASH   ;nod:slashn),
+        (tok:EQUAL   ;nod:equaln),
+        (tok:GT      ;nod:gtn),
+        (tok:LT      ;nod:ltn),
+        (tok:GTE     ;nod:gten),
+        (tok:LTE     ;nod:lten),
+        (tok:SYMDIF  ;nod:symdifn),
+        (tok:STARSTAR;nod:starstarn),
+        (tok:CARET   ;nod:caretn),
+        (tok:UNEQUAL ;nod:unequaln),
+        (tok:_AS     ;nod:asn),
+        (tok:_IN     ;nod:inn),
+        (tok:_IS     ;nod:isn),
+        (tok:_OR     ;nod:orn),
+        (tok:_AND    ;nod:andn),
+        (tok:_DIV    ;nod:divn),
+        (tok:_MOD    ;nod:modn),
+        (tok:_SHL    ;nod:shln),
+        (tok:_SHR    ;nod:shrn),
+        (tok:_XOR    ;nod:xorn)
+      );
+      operator_levels:array[Toperator_precedence] of set of Ttoken=
+         ([LT,LTE,GT,GTE,EQUAL,UNEQUAL,_IN,_IS],
+          [PLUS,MINUS,_OR,_XOR],
+          [CARET,SYMDIF,STARSTAR,STAR,SLASH,_DIV,_MOD,_AND,_SHL,_SHR,_AS]);
 
     function sub_expr(pred_level:Toperator_precedence;accept_equal : boolean):Ptree;
-
     {Reads a subexpression while the operators are of the current precedence
      level, or any higher level. Replaces the old term, simpl_expr and
      simpl2_expr.}
-
-    var p1,p2:Ptree;
-        oldt:Ttoken;
-         filepos : tfileposinfo;
-
-
-    begin
-{        if pred_level=high(Toperator_precedence) then }
-         if pred_level=opmultiply then
-         { this IS wrong   !!! PM
-            p1:=factor(getprocvar)}
-            p1:=factor(false)
+      var
+        low,high,mid : longint;
+        p1,p2   : Ptree;
+        oldt    : Ttoken;
+        filepos : tfileposinfo;
+      begin
+        if pred_level=opmultiply then
+          p1:=factor(false)
         else
-            p1:=sub_expr(succ(pred_level),true);
+          p1:=sub_expr(succ(pred_level),true);
         repeat
-            { aweful hack to support const a : 1..2=1; }
-            { disadvantage of tables :) FK             }
-            if (token in operator_levels[pred_level]) and
-               ((token<>EQUAL) or accept_equal) then
-                begin
-                    oldt:=token;
-                    filepos:=tokenpos;
-
-                    consume(token);
-{                    if pred_level=high(Toperator_precedence) then }
-                    if pred_level=opmultiply then
-                        p2:=factor(false)
-                    else
-                        p2:=sub_expr(succ(pred_level),true);
-                    p1:=gennode(tok2node[oldt],p1,p2);
-                    set_tree_filepos(p1,filepos);
-
-                end
-            else
-                break;
+          if (token in operator_levels[pred_level]) and
+             ((token<>EQUAL) or accept_equal) then
+           begin
+             oldt:=token;
+             filepos:=tokenpos;
+             consume(token);
+             if pred_level=opmultiply then
+               p2:=factor(false)
+             else
+               p2:=sub_expr(succ(pred_level),true);
+             low:=1;
+             high:=tok2nodes;
+             while (low<high) do
+              begin
+                mid:=(low+high+1) shr 1;
+                if oldt<tok2node[mid].tok then
+                 high:=mid-1
+                else
+                 low:=mid;
+              end;
+             if tok2node[high].tok=oldt then
+              p1:=gennode(tok2node[high].nod,p1,p2)
+             else
+              p1:=gennode(nothingn,p1,p2);
+             set_tree_filepos(p1,filepos);
+           end
+          else
+           break;
         until false;
         sub_expr:=p1;
-    end;
+      end;
 
-    function comp_expr(accept_equal : boolean):Ptree;
 
+    function comp_expr(accept_equal : boolean):Ptree;
       var
          oldafterassignment : boolean;
 
@@ -1748,7 +1761,10 @@ unit pexpr;
 end.
 {
   $Log$
-  Revision 1.55  1998-09-24 23:49:10  peter
+  Revision 1.56  1998-09-26 17:45:36  peter
+    + idtoken and only one token table
+
+  Revision 1.55  1998/09/24 23:49:10  peter
     + aktmodeswitches
 
   Revision 1.54  1998/09/23 15:46:39  florian

compiler/pstatmnt.pas

@@ -1000,11 +1000,6 @@ unit pstatmnt;
             _UNTIL,
             _END:
               code:=genzeronode(niln);
-            _CONTINUE:
-              begin
-                 consume(_CONTINUE);
-                 code:=genzeronode(continuen);
-              end;
             _FAIL : begin
                        { internalerror(100); }
                        if (aktprocsym^.definition^.options and poconstructor)=0 then
@@ -1012,13 +1007,6 @@ unit pstatmnt;
                        consume(_FAIL);
                        code:=genzeronode(failn);
                     end;
-            {
-            _BREAK:
-              begin
-                 consume(_BREAK);
-                 code:=genzeronode(breakn);
-              end;
-             }
             _EXIT : code:=exit_statement;
             _ASM : begin
                       code:=_asm_statement;
@@ -1226,7 +1214,10 @@ unit pstatmnt;
 end.
 {
   $Log$
-  Revision 1.41  1998-09-24 23:49:15  peter
+  Revision 1.42  1998-09-26 17:45:38  peter
+    + idtoken and only one token table
+
+  Revision 1.41  1998/09/24 23:49:15  peter
     + aktmodeswitches
 
   Revision 1.40  1998/09/23 21:53:04  florian

compiler/scandir.inc

@@ -337,8 +337,6 @@ const
 
     procedure dir_define(t:tdirectivetoken);
       var
-        ht  : ttoken;
-        hs2,
         hs  : string;
         mac : pmacrosym;
         macropos : longint;
@@ -368,11 +366,8 @@ const
         if (cs_support_macro in aktmoduleswitches) then
           begin
           { key words are never substituted }
-             hs2:=pattern;
-             pattern:=hs;
-             if is_keyword(ht) then
+             if is_keyword(hs) then
               Message(scan_e_keyword_cant_be_a_macro);
-             pattern:=hs2;
            { !!!!!! handle macro params, need we this? }
              current_scanner^.skipspace;
            { may be a macro? }
@@ -935,7 +930,10 @@ const
 
 {
   $Log$
-  Revision 1.32  1998-09-24 23:49:19  peter
+  Revision 1.33  1998-09-26 17:45:40  peter
+    + idtoken and only one token table
+
+  Revision 1.32  1998/09/24 23:49:19  peter
     + aktmodeswitches
 
   Revision 1.31  1998/09/18 16:03:44  florian

compiler/scanner.pas

@@ -36,95 +36,8 @@ unit scanner;
 {$else}
        maxmacrolen=16*1024;
 {$endif}
-
-       id_len = 14;
        Newline = #10;
 
-    type
-       ident = string[id_len];
-
-    const
-      max_keywords = 70;
-      anz_keywords : longint = max_keywords;
-
-      { the following keywords are no keywords in TP, they
-        are internal procedures
-
-      CONTINUE, DISPOSE, EXIT, FAIL, FALSE, NEW, SELF
-      TRUE
-      }
-      { INLINE is a keyword in TP, but only an modifier in FPC }
-      keyword : array[1..max_keywords] of ident = (
-{        'ABSOLUTE',}
-         'AND',
-         'ARRAY','AS','ASM',
-{        'ASSEMBLER',}
-         'BEGIN',
-         'CASE','CLASS',
-         'CONST','CONSTRUCTOR',
-         'DESTRUCTOR','DISPOSE','DIV','DO','DOWNTO','ELSE','END',
-         'EXCEPT',
-         'EXIT',
-{        'EXPORT',}
-         'EXPORTS',
-{        'EXTERNAL',}
-         'FAIL','FALSE',
-{        'FAR',}
-         'FILE','FINALIZATION','FINALLY','FOR',
-{        'FORWARD',}
-         'FUNCTION','GOTO','IF','IMPLEMENTATION','IN',
-         'INHERITED','INITIALIZATION',
-{        'INLINE',} {INLINE is a reserved word in TP. Why?}
-         'INTERFACE',
-{        'INTERRUPT',}
-         'IS',
-         'LABEL','LIBRARY','MOD',
-{        'NEAR',}
-         'NEW','NIL','NOT','OBJECT',
-         'OF','ON','OPERATOR','OR','OTHERWISE','PACKED',
-         'PROCEDURE','PROGRAM','PROPERTY',
-         'RAISE','RECORD','REPEAT','SELF',
-         'SET','SHL','SHR','STRING','THEN','TO',
-         'TRUE','TRY','TYPE','UNIT','UNTIL',
-         'USES','VAR',
-{        'VIRTUAL',}
-         'WHILE','WITH','XOR');
-
-       keyword_token : array[1..max_keywords] of ttoken = (
-{        _ABSOLUTE,}
-         _AND,
-         _ARRAY,_AS,_ASM,
-{        _ASSEMBLER,}
-         _BEGIN,
-         _CASE,_CLASS,
-         _CONST,_CONSTRUCTOR,
-         _DESTRUCTOR,_DISPOSE,_DIV,_DO,_DOWNTO,
-         _ELSE,_END,_EXCEPT,
-         _EXIT,
-{        _EXPORT,}
-         _EXPORTS,
-{        _EXTERNAL,}
-         _FAIL,_FALSE,
-{        _FAR,}
-         _FILE,_FINALIZATION,_FINALLY,_FOR,
-{        _FORWARD,}
-         _FUNCTION,_GOTO,_IF,_IMPLEMENTATION,_IN,
-         _INHERITED,_INITIALIZATION,
-{        _INLINE,}
-         _INTERFACE,
-{        _INTERRUPT,}
-         _IS,
-         _LABEL,_LIBRARY,_MOD,
-{        _NEAR,}
-         _NEW,_NIL,_NOT,_OBJECT,
-         _OF,_ON,_OPERATOR,_OR,_OTHERWISE,_PACKED,
-         _PROCEDURE,_PROGRAM,_PROPERTY,
-         _RAISE,_RECORD,_REPEAT,_SELF,
-         _SET,_SHL,_SHR,_STRING,_THEN,_TO,
-         _TRUE,_TRY,_TYPE,_UNIT,_UNTIL,
-         _USES,_VAR,
-{        _VIRTUAL,}
-         _WHILE,_WITH,_XOR);
 
     type
        pmacrobuffer = ^tmacrobuffer;
@@ -194,7 +107,7 @@ unit scanner;
           procedure skipcomment;
           procedure skipdelphicomment;
           procedure skipoldtpcomment;
-          function  yylex:ttoken;
+          procedure readtoken;
           function  readpreproc:ttoken;
           function  asmgetchar:char;
        end;
@@ -205,8 +118,6 @@ unit scanner;
         pattern        : string;
         current_scanner : pscannerfile;
 
-    { changes to keywords to be tp compatible }
-    procedure change_to_tp_keywords;
 
 implementation
 
@@ -216,62 +127,53 @@ implementation
 {*****************************************************************************
                               Helper routines
 *****************************************************************************}
-
-    function is_keyword(var token : ttoken) : boolean;
-      var
-         high,low,mid : longint;
-      begin
-         low:=1;
-         high:=anz_keywords;
-         while low<high do
-          begin
-            mid:=(high+low+1) shr 1;
-            if pattern<keyword[mid] then
-             high:=mid-1
-            else
-             low:=mid;
-          end;
-         if pattern=keyword[high] then
-          begin
-            token:=keyword_token[high];
-            is_keyword:=true;
-          end
-         else
-          is_keyword:=false;
+    type
+      tokenidxrec=record
+        first,last : ttoken;
       end;
+    var
+      tokenidx:array[2..tokenidlen] of tokenidxrec;
 
 
-    procedure remove_keyword(const s : string);
+    procedure create_tokenidx;
+    { create an index with the first and last token for every possible token
+      length, so a search only will be done in that small part }
       var
-         i,j : longint;
+        t : ttoken;
       begin
-         for i:=1 to anz_keywords do
-           begin
-              if keyword[i]=s then
-                begin
-                   for j:=i to anz_keywords-1 do
-                     begin
-                        keyword[j]:=keyword[j+1];
-                        keyword_token[j]:=keyword_token[j+1];
-                     end;
-                   dec(anz_keywords);
-                   break;
-                end;
-           end;
+        for t:=low(ttoken) to high(ttoken) do
+         begin
+           if not tokens[t].special then
+            begin
+              if ord(tokenidx[length(tokens[t].str)].first)=0 then
+               tokenidx[length(tokens[t].str)].first:=t;
+              tokenidx[length(tokens[t].str)].last:=t;
+            end;
+         end;
       end;
 
 
-    procedure change_to_tp_keywords;
-      const
-        non_tp : array[0..14] of string[id_len] = (
-           'AS','CLASS','EXCEPT','FINALLY','INITIALIZATION','IS',
-           'ON','OPERATOR','OTHERWISE','PROPERTY','RAISE','TRY',
-           'EXPORTS','LIBRARY','FINALIZATION');
+    function is_keyword(const s:string):boolean;
       var
-        i : longint;
+        low,high,mid : longint;
       begin
-        for i:=0 to 13 do
-         remove_keyword(non_tp[i]);
+        if not (length(s) in [2..tokenidlen]) then
+         begin
+           is_keyword:=false;
+           exit;
+         end;
+        low:=ord(tokenidx[length(s)].first);
+        high:=ord(tokenidx[length(s)].last);
+        while low<high do
+         begin
+           mid:=(high+low+1) shr 1;
+           if pattern<tokens[ttoken(mid)].str then
+            high:=mid-1
+           else
+            low:=mid;
+         end;
+        is_keyword:=(pattern=tokens[ttoken(high)].str) and
+                    (tokens[ttoken(high)].keyword in aktmodeswitches);
       end;
 
 
@@ -943,10 +845,10 @@ implementation
       end;
 
 
-    function tscannerfile.yylex : ttoken;
+    procedure tscannerfile.readtoken;
       var
-        y       : ttoken;
         code    : integer;
+        low,high,mid,
         l       : longint;
         mac     : pmacrosym;
         asciinr : string[3];
@@ -966,20 +868,20 @@ implementation
                     case c of
                      '.' : begin
                              readchar;
-                             yylex:=POINTPOINT;
+                             token:=POINTPOINT;
                              goto exit_label;
                            end;
                      ')' : begin
                              readchar;
-                             yylex:=RECKKLAMMER;
+                             token:=RECKKLAMMER;
                              goto exit_label;
                            end;
                     end;
-                    yylex:=POINT;
+                    token:=POINT;
                     goto exit_label;
                   end;
               2 : begin { first char was a Caret }
-                    yylex:=CARET;
+                    token:=CARET;
                     readchar;
                     goto exit_label;
                   end;
@@ -1003,9 +905,30 @@ implementation
         if c in ['_','A'..'Z','a'..'z'] then
          begin
            readstring;
-           if (length(pattern) in [2..id_len]) and is_keyword(y) then
-            yylex:=y
-           else
+           token:=ID;
+           idtoken:=ID;
+         { keyword or any other known token ? }
+           if (length(pattern) in [2..tokenidlen]) then
+            begin
+              low:=ord(tokenidx[length(pattern)].first);
+              high:=ord(tokenidx[length(pattern)].last);
+              while low<high do
+               begin
+                 mid:=(high+low+1) shr 1;
+                 if pattern<tokens[ttoken(mid)].str then
+                  high:=mid-1
+                 else
+                  low:=mid;
+               end;
+              if pattern=tokens[ttoken(high)].str then
+               begin
+                 if tokens[ttoken(high)].keyword in aktmodeswitches then
+                  token:=ttoken(high);
+                 idtoken:=ttoken(high);
+               end;
+            end;
+         { Only process identifiers and not keywords }
+           if token=ID then
             begin
             { this takes some time ... }
               if (cs_support_macro in aktmoduleswitches) then
@@ -1021,33 +944,31 @@ implementation
                     inc(yylexcount);
                     if yylexcount>16 then
                      Message(scan_w_macro_deep_ten);
-                  {$ifdef TP}
-                    yylex:=yylex;
-                  {$else}
-                    yylex:=yylex();
-                  {$endif}
+                    readtoken;
                   { that's all folks }
                     dec(yylexcount);
                     exit;
                   end;
                end;
-              yylex:=ID;
             end;
+         { a following caret, then set special handling }
            if (c='^') then
             do_special:=2;
+         { return token }
            goto exit_label;
          end
         else
          begin
+           idtoken:=NOID;
            case c of
                 '$' : begin
                          readnumber;
-                         yylex:=INTCONST;
+                         token:=INTCONST;
                          goto exit_label;
                       end;
                 '%' : begin
                          readnumber;
-                         yylex:=INTCONST;
+                         token:=INTCONST;
                          goto exit_label;
                       end;
            '0'..'9' : begin
@@ -1061,7 +982,7 @@ implementation
                               if not(c in ['0'..'9']) then
                                begin
                                  do_special:=1;
-                                 yylex:=INTCONST;
+                                 token:=INTCONST;
                                  goto exit_label;
                                end;
                               pattern:=pattern+'.';
@@ -1089,25 +1010,25 @@ implementation
                                  readchar;
                                end;
                             end;
-                           yylex:=REALNUMBER;
+                           token:=REALNUMBER;
                            goto exit_label;
                          end;
-                        yylex:=INTCONST;
+                        token:=INTCONST;
                         goto exit_label;
                       end;
                 ';' : begin
                         readchar;
-                        yylex:=SEMICOLON;
+                        token:=SEMICOLON;
                         goto exit_label;
                       end;
                 '[' : begin
                         readchar;
-                        yylex:=LECKKLAMMER;
+                        token:=LECKKLAMMER;
                         goto exit_label;
                       end;
                 ']' : begin
                         readchar;
-                        yylex:=RECKKLAMMER;
+                        token:=RECKKLAMMER;
                         goto exit_label;
                       end;
                 '(' : begin
@@ -1115,25 +1036,21 @@ implementation
                         case c of
                          '*' : begin
                                  skipoldtpcomment;
-                               {$ifndef TP}
-                                 yylex:=yylex();
-                               {$else}
-                                 yylex:=yylex;
-                               {$endif}
+                                 readtoken;
                                  exit;
                                end;
                          '.' : begin
                                  readchar;
-                                 yylex:=LECKKLAMMER;
+                                 token:=LECKKLAMMER;
                                  goto exit_label;
                                end;
                         end;
-                        yylex:=LKLAMMER;
+                        token:=LKLAMMER;
                         goto exit_label;
                       end;
                 ')' : begin
                         readchar;
-                        yylex:=RKLAMMER;
+                        token:=RKLAMMER;
                         goto exit_label;
                       end;
                 '+' : begin
@@ -1141,10 +1058,10 @@ implementation
                         if (c='=') and (cs_support_c_operators in aktmoduleswitches) then
                          begin
                            readchar;
-                           yylex:=_PLUSASN;
+                           token:=_PLUSASN;
                            goto exit_label;
                          end;
-                        yylex:=PLUS;
+                        token:=PLUS;
                         goto exit_label;
                       end;
                 '-' : begin
@@ -1152,10 +1069,10 @@ implementation
                         if (c='=') and (cs_support_c_operators in aktmoduleswitches) then
                          begin
                            readchar;
-                           yylex:=_MINUSASN;
+                           token:=_MINUSASN;
                            goto exit_label;
                          end;
-                        yylex:=MINUS;
+                        token:=MINUS;
                         goto exit_label;
                       end;
                 ':' : begin
@@ -1163,10 +1080,10 @@ implementation
                         if c='=' then
                          begin
                            readchar;
-                           yylex:=ASSIGNMENT;
+                           token:=ASSIGNMENT;
                            goto exit_label;
                          end;
-                        yylex:=COLON;
+                        token:=COLON;
                         goto exit_label;
                       end;
                 '*' : begin
@@ -1174,16 +1091,16 @@ implementation
                         if (c='=') and (cs_support_c_operators in aktmoduleswitches) then
                          begin
                            readchar;
-                           yylex:=_STARASN;
+                           token:=_STARASN;
                          end
                         else
                          if c='*' then
                           begin
                             readchar;
-                            yylex:=STARSTAR;
+                            token:=STARSTAR;
                           end
                         else
-                         yylex:=STAR;
+                         token:=STAR;
                         goto exit_label;
                       end;
                 '/' : begin
@@ -1193,26 +1110,22 @@ implementation
                                  if (cs_support_c_operators in aktmoduleswitches) then
                                   begin
                                     readchar;
-                                    yylex:=_SLASHASN;
+                                    token:=_SLASHASN;
                                     goto exit_label;
                                   end;
                                end;
                          '/' : begin
                                  skipdelphicomment;
-                               {$ifndef TP}
-                                 yylex:=yylex();
-                               {$else TP}
-                                 yylex:=yylex;
-                               {$endif TP}
+                                 readtoken;
                                  exit;
                                end;
                         end;
-                        yylex:=SLASH;
+                        token:=SLASH;
                         goto exit_label;
                       end;
                 '=' : begin
                         readchar;
-                        yylex:=EQUAL;
+                        token:=EQUAL;
                         goto exit_label;
                       end;
                 '.' : begin
@@ -1220,16 +1133,16 @@ implementation
                         case c of
                          '.' : begin
                                  readchar;
-                                 yylex:=POINTPOINT;
+                                 token:=POINTPOINT;
                                  goto exit_label;
                                end;
                          ')' : begin
                                  readchar;
-                                 yylex:=RECKKLAMMER;
+                                 token:=RECKKLAMMER;
                                  goto exit_label;
                                end;
                         end;
-                        yylex:=POINT;
+                        token:=POINT;
                         goto exit_label;
                       end;
                 '@' : begin
@@ -1237,15 +1150,15 @@ implementation
                         if c='@' then
                          begin
                            readchar;
-                           yylex:=DOUBLEADDR;
+                           token:=DOUBLEADDR;
                          end
                         else
-                         yylex:=KLAMMERAFFE;
+                         token:=KLAMMERAFFE;
                         goto exit_label;
                       end;
                 ',' : begin
                         readchar;
-                        yylex:=COMMA;
+                        token:=COMMA;
                         goto exit_label;
                       end;
       '''','#','^' :  begin
@@ -1260,7 +1173,7 @@ implementation
                             end
                            else
                             begin
-                              yylex:=CARET;
+                              token:=CARET;
                               goto exit_label;
                             end;
                          end
@@ -1325,9 +1238,9 @@ implementation
                         until false;
                       { strings with length 1 become const chars }
                         if length(pattern)=1 then
-                         yylex:=CCHAR
+                         token:=CCHAR
                         else
-                         yylex:=CSTRING;
+                         token:=CSTRING;
                         goto exit_label;
                       end;
                 '>' : begin
@@ -1335,21 +1248,21 @@ implementation
                         case c of
                          '=' : begin
                                  readchar;
-                                 yylex:=GTE;
+                                 token:=GTE;
                                  goto exit_label;
                                end;
                          '>' : begin
                                  readchar;
-                                 yylex:=_SHR;
+                                 token:=_SHR;
                                  goto exit_label;
                                end;
                          '<' : begin { >< is for a symetric diff for sets }
                                  readchar;
-                                 yylex:=SYMDIF;
+                                 token:=SYMDIF;
                                  goto exit_label;
                                end;
                         end;
-                        yylex:=GT;
+                        token:=GT;
                         goto exit_label;
                       end;
                 '<' : begin
@@ -1357,25 +1270,25 @@ implementation
                         case c of
                          '>' : begin
                                  readchar;
-                                 yylex:=UNEQUAL;
+                                 token:=UNEQUAL;
                                  goto exit_label;
                                end;
                          '=' : begin
                                  readchar;
-                                 yylex:=LTE;
+                                 token:=LTE;
                                  goto exit_label;
                                end;
                          '<' : begin
                                  readchar;
-                                 yylex:=_SHL;
+                                 token:=_SHL;
                                  goto exit_label;
                                end;
                         end;
-                        yylex:=LT;
+                        token:=LT;
                         goto exit_label;
                       end;
                 #26 : begin
-                        yylex:=_EOF;
+                        token:=_EOF;
                         goto exit_label;
                       end;
            else
@@ -1506,10 +1419,15 @@ exit_label:
          end;
       end;
 
+begin
+  create_tokenidx;
 end.
 {
   $Log$
-  Revision 1.53  1998-09-24 23:49:20  peter
+  Revision 1.54  1998-09-26 17:45:41  peter
+    + idtoken and only one token table
+
+  Revision 1.53  1998/09/24 23:49:20  peter
     + aktmodeswitches
 
   Revision 1.52  1998/09/18 16:03:45  florian

compiler/symsym.inc

@@ -431,8 +431,9 @@
 
 
     procedure tprocsym.deref;
-      var t : ttoken;
-          last : pprocdef;
+      var
+        t    : ttoken;
+        last : pprocdef;
       begin
          resolvedef(pdef(definition));
          if (definition^.options and pooperator) <> 0 then
@@ -440,7 +441,7 @@
               last:=definition;
               while assigned(last^.nextoverloaded) do
                 last:=last^.nextoverloaded;
-              for t:=PLUS to last_overloaded do
+              for t:=first_overloaded to last_overloaded do
               if (name=overloaded_names[t]) then
                 begin
                    if assigned(overloaded_operators[t]) then
@@ -1715,7 +1716,10 @@
 
 {
   $Log$
-  Revision 1.47  1998-09-24 15:11:17  peter
+  Revision 1.48  1998-09-26 17:45:44  peter
+    + idtoken and only one token table
+
+  Revision 1.47  1998/09/24 15:11:17  peter
     * fixed enum for not GDB
 
   Revision 1.46  1998/09/23 15:39:13  pierre

compiler/token.inc

@@ -0,0 +1,339 @@
+{
+    $Id$
+    Copyright (c) 1993-98 by Florian Klaempfl, Pierre Muller
+
+    Tokens used by the compiler
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ ****************************************************************************
+}
+
+const
+  tokenidlen=14;
+
+type
+  ttoken=(
+    { operators, which can also be overloaded }
+    PLUS,
+    MINUS,
+    STAR,
+    SLASH,
+    EQUAL,
+    GT,
+    LT,
+    GTE,
+    LTE,
+    SYMDIF,
+    STARSTAR,
+    OP_IS,
+    OP_AS,
+    OP_IN,
+    ASSIGNMENT,
+    { special chars }
+    CARET,
+    UNEQUAL,
+    LECKKLAMMER,
+    RECKKLAMMER,
+    POINT,
+    COMMA,
+    LKLAMMER,
+    RKLAMMER,
+    COLON,
+    SEMICOLON,
+    KLAMMERAFFE,
+    POINTPOINT,
+    DOUBLEADDR,
+    _EOF,
+    ID,
+    NOID,
+    REALNUMBER,
+    INTCONST,
+    CSTRING,
+    CCHAR,
+    { C like operators }
+    _PLUSASN,
+    _MINUSASN,
+    _ANDASN,
+    _ORASN,
+    _STARASN,
+    _SLASHASN,
+    _MODASN,
+    _DIVASN,
+    _NOTASN,
+    _XORASN,
+    { Normal words }
+    _AS,
+    _DO,
+    _IF,
+    _IN,
+    _IS,
+    _OF,
+    _ON,
+    _OR,
+    _TO,
+    _AND,
+    _ASM,
+    _DIV,
+    _END,
+    _FAR,
+    _FOR,
+    _MOD,
+    _NEW,
+    _NIL,
+    _NOT,
+    _SET,
+    _SHL,
+    _SHR,
+    _TRY,
+    _VAR,
+    _XOR,
+    _CASE,
+    _CVAR,
+    _ELSE,
+    _EXIT,
+    _FAIL,
+    _FILE,
+    _GOTO,
+    _NAME,
+    _NEAR,
+    _READ,
+    _SELF,
+    _THEN,
+    _TRUE,
+    _TYPE,
+    _UNIT,
+    _USES,
+    _WITH,
+    _ARRAY,
+    _BEGIN,
+    _BREAK,
+    _CLASS,
+    _CONST,
+    _FALSE,
+    _INDEX,
+    _LABEL,
+    _RAISE,
+    _UNTIL,
+    _WHILE,
+    _WRITE,
+    _DOWNTO,
+    _EXCEPT,
+    _EXPORT,
+    _INLINE,
+    _OBJECT,
+    _PACKED,
+    _PUBLIC,
+    _RECORD,
+    _REPEAT,
+    _STATIC,
+    _STORED,
+    _STRING,
+    _DEFAULT,
+    _DISPOSE,
+    _DYNAMIC,
+    _EXPORTS,
+    _FINALLY,
+    _FORWARD,
+    _LIBRARY,
+    _PRIVATE,
+    _PROGRAM,
+    _VIRTUAL,
+    _ABSOLUTE,
+    _ABSTRACT,
+    _CONTINUE,
+    _EXTERNAL,
+    _FUNCTION,
+    _OPERATOR,
+    _OVERRIDE,
+    _PROPERTY,
+    _RESIDENT,
+    _INHERITED,
+    _INTERFACE,
+    _INTERRUPT,
+    _NODEFAULT,
+    _OTHERWISE,
+    _PROCEDURE,
+    _PROTECTED,
+    _PUBLISHED,
+    _DESTRUCTOR,
+    _CONSTRUCTOR,
+    _FINALIZATION,
+    _IMPLEMENTATION,
+    _INITIALIZATION
+  );
+
+  tokenrec=record
+    str     : string[tokenidlen];
+    special : boolean;
+    keyword : tmodeswitch;
+  end;
+
+const
+  tokens:array[ttoken] of tokenrec=(
+    { Operators which can be overloaded }
+      (str:'+'             ;special:true ;keyword:m_none),
+      (str:'-'             ;special:true ;keyword:m_none),
+      (str:'*'             ;special:true ;keyword:m_none),
+      (str:'/'             ;special:true ;keyword:m_none),
+      (str:'='             ;special:true ;keyword:m_none),
+      (str:'>'             ;special:true ;keyword:m_none),
+      (str:'<'             ;special:true ;keyword:m_none),
+      (str:'>='            ;special:true ;keyword:m_none),
+      (str:'<='            ;special:true ;keyword:m_none),
+      (str:'><'            ;special:true ;keyword:m_none),
+      (str:'**'            ;special:true ;keyword:m_none),
+      (str:'is'            ;special:true ;keyword:m_none),
+      (str:'as'            ;special:true ;keyword:m_none),
+      (str:'in'            ;special:true ;keyword:m_none),
+      (str:':='            ;special:true ;keyword:m_none),
+    { Special chars }
+      (str:'^'             ;special:true ;keyword:m_none),
+      (str:'<>'            ;special:true ;keyword:m_none),
+      (str:'['             ;special:true ;keyword:m_none),
+      (str:']'             ;special:true ;keyword:m_none),
+      (str:'.'             ;special:true ;keyword:m_none),
+      (str:','             ;special:true ;keyword:m_none),
+      (str:'('             ;special:true ;keyword:m_none),
+      (str:')'             ;special:true ;keyword:m_none),
+      (str:':'             ;special:true ;keyword:m_none),
+      (str:';'             ;special:true ;keyword:m_none),
+      (str:'@'             ;special:true ;keyword:m_none),
+      (str:'..'            ;special:true ;keyword:m_none),
+      (str:'@@'            ;special:true ;keyword:m_none),
+      (str:'end of file'   ;special:true ;keyword:m_none),
+      (str:'identifier'    ;special:true ;keyword:m_none),
+      (str:'non identifier';special:true ;keyword:m_none),
+      (str:'const real'    ;special:true ;keyword:m_none),
+      (str:'ordinal const' ;special:true ;keyword:m_none),
+      (str:'const string'  ;special:true ;keyword:m_none),
+      (str:'const char'    ;special:true ;keyword:m_none),
+    { C like operators }
+      (str:'+='            ;special:true ;keyword:m_none),
+      (str:'-='            ;special:true ;keyword:m_none),
+      (str:'&='            ;special:true ;keyword:m_none),
+      (str:'|='            ;special:true ;keyword:m_none),
+      (str:'*='            ;special:true ;keyword:m_none),
+      (str:'/='            ;special:true ;keyword:m_none),
+      (str:''              ;special:true ;keyword:m_none),
+      (str:''              ;special:true ;keyword:m_none),
+      (str:''              ;special:true ;keyword:m_none),
+      (str:''              ;special:true ;keyword:m_none),
+    { Normal words }
+      (str:'AS'            ;special:false;keyword:m_class),
+      (str:'DO'            ;special:false;keyword:m_all),
+      (str:'IF'            ;special:false;keyword:m_all),
+      (str:'IN'            ;special:false;keyword:m_all),
+      (str:'IS'            ;special:false;keyword:m_class),
+      (str:'OF'            ;special:false;keyword:m_all),
+      (str:'ON'            ;special:false;keyword:m_objpas),
+      (str:'OR'            ;special:false;keyword:m_all),
+      (str:'TO'            ;special:false;keyword:m_all),
+      (str:'AND'           ;special:false;keyword:m_all),
+      (str:'ASM'           ;special:false;keyword:m_all),
+      (str:'DIV'           ;special:false;keyword:m_all),
+      (str:'END'           ;special:false;keyword:m_all),
+      (str:'FAR'           ;special:false;keyword:m_all),
+      (str:'FOR'           ;special:false;keyword:m_all),
+      (str:'MOD'           ;special:false;keyword:m_all),
+      (str:'NEW'           ;special:false;keyword:m_all),
+      (str:'NIL'           ;special:false;keyword:m_all),
+      (str:'NOT'           ;special:false;keyword:m_all),
+      (str:'SET'           ;special:false;keyword:m_all),
+      (str:'SHL'           ;special:false;keyword:m_all),
+      (str:'SHR'           ;special:false;keyword:m_all),
+      (str:'TRY'           ;special:false;keyword:m_objpas),
+      (str:'VAR'           ;special:false;keyword:m_all),
+      (str:'XOR'           ;special:false;keyword:m_all),
+      (str:'CASE'          ;special:false;keyword:m_all),
+      (str:'CVAR'          ;special:false;keyword:m_none),
+      (str:'ELSE'          ;special:false;keyword:m_all),
+      (str:'EXIT'          ;special:false;keyword:m_all),
+      (str:'FAIL'          ;special:false;keyword:m_all),
+      (str:'FILE'          ;special:false;keyword:m_all),
+      (str:'GOTO'          ;special:false;keyword:m_all),
+      (str:'NAME'          ;special:false;keyword:m_none),
+      (str:'NEAR'          ;special:false;keyword:m_all),
+      (str:'READ'          ;special:false;keyword:m_none),
+      (str:'SELF'          ;special:false;keyword:m_all),
+      (str:'THEN'          ;special:false;keyword:m_all),
+      (str:'TRUE'          ;special:false;keyword:m_all),
+      (str:'TYPE'          ;special:false;keyword:m_all),
+      (str:'UNIT'          ;special:false;keyword:m_all),
+      (str:'USES'          ;special:false;keyword:m_all),
+      (str:'WITH'          ;special:false;keyword:m_all),
+      (str:'ARRAY'         ;special:false;keyword:m_all),
+      (str:'BEGIN'         ;special:false;keyword:m_all),
+      (str:'BREAK'         ;special:false;keyword:m_none),
+      (str:'CLASS'         ;special:false;keyword:m_class),
+      (str:'CONST'         ;special:false;keyword:m_all),
+      (str:'FALSE'         ;special:false;keyword:m_all),
+      (str:'INDEX'         ;special:false;keyword:m_none),
+      (str:'LABEL'         ;special:false;keyword:m_all),
+      (str:'RAISE'         ;special:false;keyword:m_objpas),
+      (str:'UNTIL'         ;special:false;keyword:m_all),
+      (str:'WHILE'         ;special:false;keyword:m_all),
+      (str:'WRITE'         ;special:false;keyword:m_none),
+      (str:'DOWNTO'        ;special:false;keyword:m_all),
+      (str:'EXCEPT'        ;special:false;keyword:m_objpas),
+      (str:'EXPORT'        ;special:false;keyword:m_none),
+      (str:'INLINE'        ;special:false;keyword:m_all),
+      (str:'OBJECT'        ;special:false;keyword:m_all),
+      (str:'PACKED'        ;special:false;keyword:m_all),
+      (str:'PUBLIC'        ;special:false;keyword:m_none),
+      (str:'RECORD'        ;special:false;keyword:m_all),
+      (str:'REPEAT'        ;special:false;keyword:m_all),
+      (str:'STATIC'        ;special:false;keyword:m_none),
+      (str:'STORED'        ;special:false;keyword:m_none),
+      (str:'STRING'        ;special:false;keyword:m_all),
+      (str:'DEFAULT'       ;special:false;keyword:m_none),
+      (str:'DISPOSE'       ;special:false;keyword:m_all),
+      (str:'DYNAMIC'       ;special:false;keyword:m_none),
+      (str:'EXPORTS'       ;special:false;keyword:m_all),
+      (str:'FINALLY'       ;special:false;keyword:m_objpas),
+      (str:'FORWARD'       ;special:false;keyword:m_none),
+      (str:'LIBRARY'       ;special:false;keyword:m_all),
+      (str:'PRIVATE'       ;special:false;keyword:m_none),
+      (str:'PROGRAM'       ;special:false;keyword:m_all),
+      (str:'VIRTUAL'       ;special:false;keyword:m_none),
+      (str:'ABSOLUTE'      ;special:false;keyword:m_none),
+      (str:'ABSTRACT'      ;special:false;keyword:m_none),
+      (str:'CONTINUE'      ;special:false;keyword:m_none),
+      (str:'EXTERNAL'      ;special:false;keyword:m_none),
+      (str:'FUNCTION'      ;special:false;keyword:m_all),
+      (str:'OPERATOR'      ;special:false;keyword:m_fpc),
+      (str:'OVERRIDE'      ;special:false;keyword:m_none),
+      (str:'PROPERTY'      ;special:false;keyword:m_class),
+      (str:'RESIDENT'      ;special:false;keyword:m_none),
+      (str:'INHERITED'     ;special:false;keyword:m_all),
+      (str:'INTERFACE'     ;special:false;keyword:m_all),
+      (str:'INTERRUPT'     ;special:false;keyword:m_none),
+      (str:'NODEFAULT'     ;special:false;keyword:m_none),
+      (str:'OTHERWISE'     ;special:false;keyword:m_all),
+      (str:'PROCEDURE'     ;special:false;keyword:m_all),
+      (str:'PROTECTED'     ;special:false;keyword:m_none),
+      (str:'PUBLISHED'     ;special:false;keyword:m_none),
+      (str:'DESTRUCTOR'    ;special:false;keyword:m_all),
+      (str:'CONSTRUCTOR'   ;special:false;keyword:m_all),
+      (str:'FINALIZATION'  ;special:false;keyword:m_class),
+      (str:'IMPLEMENTATION';special:false;keyword:m_all),
+      (str:'INITIALIZATION';special:false;keyword:m_class)
+  );
+
+{
+  $Log$
+  Revision 1.1  1998-09-26 17:45:47  peter
+    + idtoken and only one token table
+
+}