* Could not compile with TP, some arrays moved to heap

  * NOAG386BIN default for TP
  * AG386* files were not compatible with TP, fixed.

compiler/Makefile

@@ -275,12 +275,12 @@ msg: msgtxt.inc
 
 # Make only the compiler
 ifndef COMPLETE
-$(EXENAME) : $(wildcard *.pas) $(wildcard *.inc) msg
+$(EXENAME) : $(wildcard *.pas) $(wildcard *.inc) msg tokens.dat
 	$(COMPILER) pp.pas
 	$(EXECPPAS)
 	$(MOVE) $(PPEXENAME) $(EXENAME)
 else
-$(EXENAME) : $(wildcard *.pas) $(wildcard *.inc) msg
+$(EXENAME) : $(wildcard *.pas) $(wildcard *.inc) msg tokens.dat
 	$(COMPILER) $(LOCALOPT) pp.pas
 	$(EXECPPAS)
 	$(COMPILER) $(LOCALOPT) pp.pas
@@ -290,6 +290,10 @@ $(EXENAME) : $(wildcard *.pas) $(wildcard *.inc) msg
 	$(MOVE) $(PPEXENAME) $(EXENAME)
 endif
 
+tokens.dat : $(wildcard *.pas) $(wildcard *.inc)
+	$(COMPILER) $(LOCALOPT) tokendat.pas
+	./tokendat
+
 # This target remakes the units with the currently made version
 remake: $(EXENAME)
 	$(MOVE) $(EXENAME) $(TEMPNAME)
@@ -399,7 +403,12 @@ $(M68KEXENAME): $(PASFILES) $(INCFILES)
 
 #
 # $Log$
-# Revision 1.35  1999-08-15 22:16:51  michael
+# Revision 1.36  1999-09-02 18:47:41  daniel
+#   * Could not compile with TP, some arrays moved to heap
+#   * NOAG386BIN default for TP
+#   * AG386* files were not compatible with TP, fixed.
+#
+# Revision 1.35  1999/08/15 22:16:51  michael
 # + No Intel and binary writer for linux=smaller executable
 #
 # Revision 1.34  1999/06/15 15:10:06  peter

compiler/ag386int.pas

@@ -574,9 +574,9 @@ ait_stab_function_name : ;
     var
       currentasmlist : PAsmList;
 
-    procedure writeexternal(p:pasmsymbol);{$ifndef FPC}far;{$endif}
+    procedure writeexternal(p:pnamedindexobject);{$ifndef FPC}far;{$endif}
       begin
-        if p^.typ=AS_EXTERNAL then
+        if pasmsymbol(p)^.typ=AS_EXTERNAL then
          currentasmlist^.AsmWriteln(#9'EXTRN'#9+p^.name);
       end;
 
@@ -627,7 +627,12 @@ ait_stab_function_name : ;
 end.
 {
   $Log$
-  Revision 1.52  1999-08-25 11:59:36  jonas
+  Revision 1.53  1999-09-02 18:47:42  daniel
+    * Could not compile with TP, some arrays moved to heap
+    * NOAG386BIN default for TP
+    * AG386* files were not compatible with TP, fixed.
+
+  Revision 1.52  1999/08/25 11:59:36  jonas
     * changed pai386, paippc and paiapha (same for tai*) to paicpu (taicpu)
 
   Revision 1.51  1999/08/04 00:22:36  florian

compiler/ag386nsm.pas

@@ -550,9 +550,9 @@ ait_stab_function_name : ;
     var
       currentasmlist : PAsmList;
 
-    procedure writeexternal(p:pasmsymbol);{$ifndef FPC}far;{$endif}
+    procedure writeexternal(p:pnamedindexobject);{$ifndef FPC}far;{$endif}
       begin
-        if p^.typ=AS_EXTERNAL then
+        if pasmsymbol(p)^.typ=AS_EXTERNAL then
          currentasmlist^.AsmWriteln('EXTERN'#9+p^.name);
       end;
 
@@ -602,7 +602,12 @@ ait_stab_function_name : ;
 end.
 {
   $Log$
-  Revision 1.49  1999-08-25 11:59:38  jonas
+  Revision 1.50  1999-09-02 18:47:43  daniel
+    * Could not compile with TP, some arrays moved to heap
+    * NOAG386BIN default for TP
+    * AG386* files were not compatible with TP, fixed.
+
+  Revision 1.49  1999/08/25 11:59:38  jonas
     * changed pai386, paippc and paiapha (same for tai*) to paicpu (taicpu)
 
   Revision 1.48  1999/08/04 00:22:37  florian

compiler/assemble.pas

@@ -144,7 +144,7 @@ end;
 const
   lastas  : byte=255;
 var
-  LastASBin : string;
+  LastASBin : pathstr;
 Function TAsmList.FindAssembler:string;
 var
   asfound : boolean;
@@ -557,7 +557,12 @@ end;
 end.
 {
   $Log$
-  Revision 1.52  1999-07-18 10:19:42  florian
+  Revision 1.53  1999-09-02 18:47:44  daniel
+    * Could not compile with TP, some arrays moved to heap
+    * NOAG386BIN default for TP
+    * AG386* files were not compatible with TP, fixed.
+
+  Revision 1.52  1999/07/18 10:19:42  florian
     * made it compilable with Dlephi 4 again
     + fixed problem with large stack allocations on win32
 

compiler/compiler.pas

@@ -121,7 +121,7 @@ uses
   dos,
 {$endif Delphi}
   verbose,comphook,systems,
-  globals,options,parser,symtable,link,import,export;
+  globals,options,parser,symtable,link,import,export,tokens;
 
 function Compile(const cmd:string):longint;
 
@@ -177,6 +177,7 @@ begin
   CompilerInited:=false;
   DoneSymtable;
   DoneGlobals;
+  donetokens;
 {$ifdef USEEXCEPT}
   recoverpospointer:=nil;
   longjump_used:=false;
@@ -198,6 +199,7 @@ begin
   InitBrowserCol;
 {$endif BrowserCol}
   InitGlobals;
+  inittokens;
   InitSymtable;
   CompilerInited:=true;
 { read the arguments }
@@ -297,7 +299,12 @@ end;
 end.
 {
   $Log$
-  Revision 1.31  1999-08-20 10:17:01  michael
+  Revision 1.32  1999-09-02 18:47:44  daniel
+    * Could not compile with TP, some arrays moved to heap
+    * NOAG386BIN default for TP
+    * AG386* files were not compatible with TP, fixed.
+
+  Revision 1.31  1999/08/20 10:17:01  michael
   + Patch from pierre
 
   Revision 1.30  1999/08/11 17:26:31  peter

compiler/pbase.pas

@@ -90,7 +90,7 @@ unit pbase;
 
     function tokenstring(i : ttoken):string;
       begin
-        tokenstring:=tokeninfo[i].str;
+        tokenstring:=tokeninfo^[i].str;
       end;
 
     { consumes token i, write error if token is different }
@@ -98,9 +98,9 @@ unit pbase;
       begin
         if (token<>i) and (idtoken<>i) then
           if token=_id then
-            Message2(scan_f_syn_expected,tokeninfo[i].str,'identifier '+pattern)
+            Message2(scan_f_syn_expected,tokeninfo^[i].str,'identifier '+pattern)
           else
-            Message2(scan_f_syn_expected,tokeninfo[i].str,tokeninfo[token].str)
+            Message2(scan_f_syn_expected,tokeninfo^[i].str,tokeninfo^[token].str)
         else
           begin
             if token=_END then
@@ -165,7 +165,12 @@ end.
 
 {
   $Log$
-  Revision 1.24  1999-08-04 13:02:50  jonas
+  Revision 1.25  1999-09-02 18:47:44  daniel
+    * Could not compile with TP, some arrays moved to heap
+    * NOAG386BIN default for TP
+    * AG386* files were not compatible with TP, fixed.
+
+  Revision 1.24  1999/08/04 13:02:50  jonas
     * all tokens now start with an underscore
     * PowerPC compiles!!
 

compiler/pp.pas

@@ -38,7 +38,7 @@
                       use external messagefiles, default for TP
   NOAG386INT          no Intel Assembler output
   NOAG386NSM          no NASM output
-  NOAG386BIN          leaves out the binary writer
+  NOAG386BIN          leaves out the binary writer, default for TP
   LOGMEMBLOCKS        adds memory manager which logs the size of
                       each allocated memory block, the information
                       is written to memuse.log after compiling
@@ -95,6 +95,7 @@ program pp;
   {$IFDEF DPMI}
     {$UNDEF USEOVERLAY}
   {$ENDIF}
+  {$DEFINE NOAG386BIN}
 {$ENDIF}
 {$ifdef FPC}
   {$UNDEF USEOVERLAY}
@@ -279,7 +280,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.46  1999-08-28 15:34:20  florian
+  Revision 1.47  1999-09-02 18:47:45  daniel
+    * Could not compile with TP, some arrays moved to heap
+    * NOAG386BIN default for TP
+    * AG386* files were not compatible with TP, fixed.
+
+  Revision 1.46  1999/08/28 15:34:20  florian
     * bug 519 fixed
 
   Revision 1.45  1999/08/04 00:23:18  florian

compiler/psub.pas

@@ -2013,17 +2013,17 @@ begin
        names^.insert(aktprocsym^.definition^.mangledname);
       { set _FAIL as keyword if constructor }
       if (aktprocsym^.definition^.proctypeoption=potype_constructor) then
-        tokeninfo[_FAIL].keyword:=m_all;
+        tokeninfo^[_FAIL].keyword:=m_all;
       if assigned(aktprocsym^.definition^._class) then
-        tokeninfo[_SELF].keyword:=m_all;
+        tokeninfo^[_SELF].keyword:=m_all;
 
        compile_proc_body(names^,((pdflags and pd_global)<>0),assigned(oldprocinfo._class));
 
       { reset _FAIL as normal }
       if (aktprocsym^.definition^.proctypeoption=potype_constructor) then
-        tokeninfo[_FAIL].keyword:=m_none;
+        tokeninfo^[_FAIL].keyword:=m_none;
       if assigned(aktprocsym^.definition^._class) and (lexlevel=main_program_level) then
-        tokeninfo[_SELF].keyword:=m_none;
+        tokeninfo^[_SELF].keyword:=m_none;
        consume(_SEMICOLON);
      end;
 { close }
@@ -2052,7 +2052,12 @@ end.
 
 {
   $Log$
-  Revision 1.17  1999-08-30 10:17:57  peter
+  Revision 1.18  1999-09-02 18:47:45  daniel
+    * Could not compile with TP, some arrays moved to heap
+    * NOAG386BIN default for TP
+    * AG386* files were not compatible with TP, fixed.
+
+  Revision 1.17  1999/08/30 10:17:57  peter
     * fixed crash in psub
     * ansistringcompare fixed
     * support for #$0b8

compiler/scandir.inc

@@ -21,7 +21,7 @@
  ****************************************************************************
 }
 const
-   directivelen=16;
+   directivelen=15;
 type
    directivestr=string[directivelen];
    tdirectivetoken=(
@@ -54,30 +54,81 @@ const
    firstdirective=_DIR_NONE;
    lastdirective=_DIR_Z4;
    directive:array[tdirectivetoken] of directivestr=(
+     {12345678901234567890 (To determine longest string.)}
      '',
-     'ALIGN','APPTYPE','ASMMODE','ASSERTIONS',
+     'ALIGN',
+     'APPTYPE',
+     'ASMMODE',
+     'ASSERTIONS',
      'BOOLEVAL',
-     'D','DEBUGINFO','DEFINE','DESCRIPTION',
-     'ELSE','ENDIF','ERROR','EXTENDEDSYNTAX',
+     'D',
+     'DEBUGINFO',
+     'DEFINE',
+     'DESCRIPTION',
+     'ELSE',
+     'ENDIF',
+     'ERROR',
+     'EXTENDEDSYNTAX',
      'FATAL',
      'GOTO',
-     'HINT','HINTS',
-     'I','I386_ATT','I386_DIRECT','I386_INTEL','IOCHECKS',
-       'IF','IFDEF','IFNDEF','IFOPT','INCLUDE','INCLUDEPATH',
-       'INFO','INLINE',
-     'L','LIBRARYPATH','LINK','LINKLIB','LOCALSYMBOLS',
-       'LONGSTRINGS',
-     'M','MACRO','MEMORY','MESSAGE','MINENUMSIZE','MMX','MODE',
-     'NOTE','NOTES',
-     'OBJECTPATH','OPENSTRINGS','OUTPUT_FORMAT','OVERFLOWCHECKS',
-     'PACKENUM','PACKRECORDS',
-     'R','RANGECHECKS','REFERENCEINFO',
-     'SATURATION','SMARTLINK','STACKFRAMES','STATIC','STOP',
-     'TYPEDADDRESS','TYPEINFO',
-     'UNDEF','UNITPATH',
+     'HINT',
+     'HINTS',
+     'I',
+     {12345678901234567890 (To determine longest string.)}
+     'I386_ATT',
+     'I386_DIRECT',
+     'I386_INTEL',
+     'IOCHECKS',
+     'IF',
+     'IFDEF',
+     'IFNDEF',
+     'IFOPT',
+     'INCLUDE',
+     'INCLUDEPATH',
+     'INFO',
+     'INLINE',
+     'L',
+     'LIBRARYPATH',
+     'LINK',
+     'LINKLIB',
+     'LOCALSYMBOLS',
+     'LONGSTRINGS',
+     'M',
+     {12345678901234567890 (To determine longest string.)}
+     'MACRO',
+     'MEMORY',
+     'MESSAGE',
+     'MINENUMSIZE',
+     'MMX',
+     'MODE',
+     'NOTE',
+     'NOTES',
+     'OBJECTPATH',
+     'OPENSTRINGS',
+     'OUTPUT_FORMAT',
+     'OVERFLOWCHECKS',
+     'PACKENUM',
+     'PACKRECORDS',
+     'R',
+     'RANGECHECKS',
+     'REFERENCEINFO',
+     'SATURATION',
+     'SMARTLINK',
+     {12345678901234567890 (To determine longest string.)}
+     'STACKFRAMES',
+     'STATIC',
+     'STOP',
+     'TYPEDADDRESS',
+     'TYPEINFO',
+     'UNDEF',
+     'UNITPATH',
      'VARSTRINGCHECKS',
-     'WAIT','WARNING','WARNINGS',
-     'Z1','Z2','Z4'
+     'WAIT',
+     'WARNING',
+     'WARNINGS',
+     'Z1',
+     'Z2',
+     'Z4'
      );
 
 
@@ -307,8 +358,6 @@ const
                   current_scanner^.skipspace;
                   hs:=current_scanner^.readid;
                   mac:=pmacrosym(macros^.search(hs));
-                  if assigned(mac) then
-                    mac^.is_used:=true;
                   current_scanner^.addpreprocstack(pp_ifdef,assigned(mac) and mac^.defined,hs,scan_c_ifdef_found);
                 end;
    _DIR_IFOPT : begin
@@ -335,8 +384,6 @@ const
                   current_scanner^.skipspace;
                   hs:=current_scanner^.readid;
                   mac:=pmacrosym(macros^.search(hs));
-                  if assigned(mac) then
-                    mac^.is_used:=true;
                   current_scanner^.addpreprocstack(pp_ifndef,not(assigned(mac) and mac^.defined),hs,scan_c_ifndef_found);
                 end;
            end;
@@ -387,7 +434,6 @@ const
                mac^.buftext:=nil;
              end;
           end;
-        mac^.is_used:=true;
         if (cs_support_macro in aktmoduleswitches) then
           begin
           { key words are never substituted }
@@ -455,7 +501,6 @@ const
                   mac^.buftext:=nil;
                end;
           end;
-        mac^.is_used:=true;
       end;
 
 
@@ -1095,8 +1140,10 @@ const
 
 {
   $Log$
-  Revision 1.60  1999-08-31 15:55:45  pierre
-   + tmacrosym.is_used set
+  Revision 1.61  1999-09-02 18:47:46  daniel
+    * Could not compile with TP, some arrays moved to heap
+    * NOAG386BIN default for TP
+    * AG386* files were not compatible with TP, fixed.
 
   Revision 1.59  1999/08/05 16:53:10  peter
     * V_Fatal=1, all other V_ are also increased

compiler/scanner.pas

@@ -141,39 +141,13 @@ implementation
                               Helper routines
 *****************************************************************************}
 
-    type
-      tokenidxrec=record
-        first,last : ttoken;
-      end;
-    var
-      tokenidx:array[2..tokenidlen,'A'..'Z'] of tokenidxrec;
-
     const
       { use any special name that is an invalid file name to avoid problems }
       macro_special_name = '____Macro____';
-      preprocstring : array [preproctyp] of string[7]
+      preprocstring : array [preproctyp] of string[6]
         = ('$IFDEF','$IFNDEF','$IF','$IFOPT','$ELSE');
 
 
-    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
-        t : ttoken;
-      begin
-        fillchar(tokenidx,sizeof(tokenidx),0);
-        for t:=low(ttoken) to high(ttoken) do
-         begin
-           if not tokeninfo[t].special then
-            begin
-              if ord(tokenidx[length(tokeninfo[t].str),tokeninfo[t].str[1]].first)=0 then
-               tokenidx[length(tokeninfo[t].str),tokeninfo[t].str[1]].first:=t;
-              tokenidx[length(tokeninfo[t].str),tokeninfo[t].str[1]].last:=t;
-            end;
-         end;
-      end;
-
-
     function is_keyword(const s:string):boolean;
       var
         low,high,mid : longint;
@@ -183,18 +157,18 @@ implementation
            is_keyword:=false;
            exit;
          end;
-        low:=ord(tokenidx[length(s),s[1]].first);
-        high:=ord(tokenidx[length(s),s[1]].last);
+        low:=ord(tokenidx^[length(s),s[1]].first);
+        high:=ord(tokenidx^[length(s),s[1]].last);
         while low<high do
          begin
            mid:=(high+low+1) shr 1;
-           if pattern<tokeninfo[ttoken(mid)].str then
+           if pattern<tokeninfo^[ttoken(mid)].str then
             high:=mid-1
            else
             low:=mid;
          end;
-        is_keyword:=(pattern=tokeninfo[ttoken(high)].str) and
-                    (tokeninfo[ttoken(high)].keyword in aktmodeswitches);
+        is_keyword:=(pattern=tokeninfo^[ttoken(high)].str) and
+                    (tokeninfo^[ttoken(high)].keyword in aktmodeswitches);
       end;
 
 
@@ -1102,19 +1076,19 @@ implementation
            pattern is always uppercased }
            if (pattern[1]<>'_') and (length(pattern) in [2..tokenidlen]) then
             begin
-              low:=ord(tokenidx[length(pattern),pattern[1]].first);
-              high:=ord(tokenidx[length(pattern),pattern[1]].last);
+              low:=ord(tokenidx^[length(pattern),pattern[1]].first);
+              high:=ord(tokenidx^[length(pattern),pattern[1]].last);
               while low<high do
                begin
                  mid:=(high+low+1) shr 1;
-                 if pattern<tokeninfo[ttoken(mid)].str then
+                 if pattern<tokeninfo^[ttoken(mid)].str then
                   high:=mid-1
                  else
                   low:=mid;
                end;
-              if pattern=tokeninfo[ttoken(high)].str then
+              if pattern=tokeninfo^[ttoken(high)].str then
                begin
-                 if tokeninfo[ttoken(high)].keyword in aktmodeswitches then
+                 if tokeninfo^[ttoken(high)].keyword in aktmodeswitches then
                   token:=ttoken(high);
                  idtoken:=ttoken(high);
                end;
@@ -1692,12 +1666,15 @@ exit_label:
          end;
       end;
 
-begin
-  create_tokenidx;
 end.
 {
   $Log$
-  Revision 1.93  1999-08-30 10:17:58  peter
+  Revision 1.94  1999-09-02 18:47:47  daniel
+    * Could not compile with TP, some arrays moved to heap
+    * NOAG386BIN default for TP
+    * AG386* files were not compatible with TP, fixed.
+
+  Revision 1.93  1999/08/30 10:17:58  peter
     * fixed crash in psub
     * ansistringcompare fixed
     * support for #$0b8

compiler/tokendat.pas

@@ -0,0 +1,253 @@
+{
+    $Id$
+    Copyright (c) 1999 by Daniel Mantione, Peter Vreman
+    Members of the Free Pascal development team
+
+    This little program generates a file of tokendata
+
+    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.
+
+ ****************************************************************************
+}
+program tokendat;
+
+uses    tokens,globtype;
+
+const
+  tokeninfo:array[ttoken] of tokenrec=(
+      (str:''              ;special:true ;keyword:m_none),
+    { 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:'AT'            ;special:false;keyword:m_none),
+      (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_class),
+      (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_none),
+      (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_class),
+      (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_none), { only set within constructors PM }
+      (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_none),
+      (str:'READ'          ;special:false;keyword:m_none),
+      (str:'SELF'          ;special:false;keyword:m_none), {set inside methods only PM }
+      (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:'ALIAS'         ;special:false;keyword:m_none),
+      (str:'ARRAY'         ;special:false;keyword:m_all),
+      (str:'BEGIN'         ;special:false;keyword:m_all),
+      (str:'BREAK'         ;special:false;keyword:m_none),
+      (str:'CDECL'         ;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_class),
+      (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_class),
+      (str:'EXPORT'        ;special:false;keyword:m_none),
+      (str:'INLINE'        ;special:false;keyword:m_none),
+      (str:'OBJECT'        ;special:false;keyword:m_all),
+      (str:'PACKED'        ;special:false;keyword:m_all),
+      (str:'PASCAL'        ;special:false;keyword:m_none),
+      (str:'PUBLIC'        ;special:false;keyword:m_none),
+      (str:'RECORD'        ;special:false;keyword:m_all),
+      (str:'REPEAT'        ;special:false;keyword:m_all),
+      (str:'RESULT'        ;special:false;keyword:m_none),
+      (str:'STATIC'        ;special:false;keyword:m_none),
+      (str:'STORED'        ;special:false;keyword:m_none),
+      (str:'STRING'        ;special:false;keyword:m_all),
+      (str:'SYSTEM'        ;special:false;keyword:m_none),
+      (str:'ASMNAME'       ;special:false;keyword:m_none),
+      (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_class),
+      (str:'FORWARD'       ;special:false;keyword:m_none),
+      (str:'IOCHECK'       ;special:false;keyword:m_none),
+      (str:'LIBRARY'       ;special:false;keyword:m_all),
+      (str:'MESSAGE'       ;special:false;keyword:m_none),
+      (str:'PRIVATE'       ;special:false;keyword:m_none),
+      (str:'PROGRAM'       ;special:false;keyword:m_all),
+      (str:'STDCALL'       ;special:false;keyword:m_none),
+      (str:'SYSCALL'       ;special:false;keyword:m_none),
+      (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:'POPSTACK'      ;special:false;keyword:m_none),
+      (str:'PROPERTY'      ;special:false;keyword:m_class),
+      (str:'REGISTER'      ;special:false;keyword:m_none),
+      (str:'RESIDENT'      ;special:false;keyword:m_none),
+      (str:'SAFECALL'      ;special:false;keyword:m_none),
+      (str:'ASSEMBLER'     ;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:'THREADVAR'     ;special:false;keyword:m_class),
+      (str:'DESTRUCTOR'    ;special:false;keyword:m_all),
+      (str:'INTERNPROC'    ;special:false;keyword:m_none),
+      (str:'OPENSTRING'    ;special:false;keyword:m_none),
+      (str:'CONSTRUCTOR'   ;special:false;keyword:m_all),
+      (str:'INTERNCONST'   ;special:false;keyword:m_none),
+      (str:'SHORTSTRING'   ;special:false;keyword:m_none),
+      (str:'FINALIZATION'  ;special:false;keyword:m_initfinal),
+      (str:'SAVEREGISTERS' ;special:false;keyword:m_none),
+      (str:'IMPLEMENTATION';special:false;keyword:m_all),
+      (str:'INITIALIZATION';special:false;keyword:m_initfinal),
+      (str:'RESOURCESTRING';special:false;keyword:m_class)
+  );
+
+{Header is designed both to identify the file and to display a nice
+ message when you use the type command on it.
+
+Explanation:
+
+#8      String length is also displayed. A backspace erases it.
+#13#10  Needed to display dos prompt on next line.
+#26     End of file. Causes type to stop reading the file.
+}
+
+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 t : ttoken;
+
+begin
+  fillchar(tokenidx^,sizeof(tokenidx^),0);
+  for t:=low(ttoken) to high(ttoken) do
+   begin
+     if not tokeninfo[t].special then
+      begin
+        if ord(tokenidx^[length(tokeninfo[t].str),tokeninfo[t].str[1]].first)=0 then
+         tokenidx^[length(tokeninfo[t].str),tokeninfo[t].str[1]].first:=t;
+        tokenidx^[length(tokeninfo[t].str),tokeninfo[t].str[1]].last:=t;
+      end;
+   end;
+end;
+
+const   headerstr:string[length(tokheader)]=tokheader;
+
+var f:file;
+    a:longint;
+
+begin
+    new(tokenidx);
+    create_tokenidx;
+    assign(f,'tokens.dat');
+    rewrite(f,1);
+    {Write header...}
+    blockwrite(f,headerstr,sizeof(headerstr));
+    {Write size of tokeninfo.}
+    a:=sizeof(tokeninfo);
+    blockwrite(f,a,sizeof(a));
+    {Write tokeninfo.}
+    blockwrite(f,tokeninfo,sizeof(tokeninfo));
+    {Write tokenindex.}
+    blockwrite(f,tokenidx^,sizeof(tokenidx^));
+    close(f);
+    dispose(tokenidx);
+end.

compiler/tokens.pas

@@ -27,6 +27,7 @@ uses
 
 const
   tokenidlen=14;
+  tokheader=#8'Free Pascal Compiler -- Token data'#13#10#26;
 
 type
   ttoken=(NOTOKEN,
@@ -208,186 +209,75 @@ type
     encoded : longint;
   end;
 
-const
-  tokeninfo:array[ttoken] of tokenrec=(
-      (str:''              ;special:true ;keyword:m_none),
-    { 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:'AT'            ;special:false;keyword:m_none),
-      (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_class),
-      (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_none),
-      (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_class),
-      (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_none), { only set within constructors PM }
-      (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_none),
-      (str:'READ'          ;special:false;keyword:m_none),
-      (str:'SELF'          ;special:false;keyword:m_none), {set inside methods only PM }
-      (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:'ALIAS'         ;special:false;keyword:m_none),
-      (str:'ARRAY'         ;special:false;keyword:m_all),
-      (str:'BEGIN'         ;special:false;keyword:m_all),
-      (str:'BREAK'         ;special:false;keyword:m_none),
-      (str:'CDECL'         ;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_class),
-      (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_class),
-      (str:'EXPORT'        ;special:false;keyword:m_none),
-      (str:'INLINE'        ;special:false;keyword:m_none),
-      (str:'OBJECT'        ;special:false;keyword:m_all),
-      (str:'PACKED'        ;special:false;keyword:m_all),
-      (str:'PASCAL'        ;special:false;keyword:m_none),
-      (str:'PUBLIC'        ;special:false;keyword:m_none),
-      (str:'RECORD'        ;special:false;keyword:m_all),
-      (str:'REPEAT'        ;special:false;keyword:m_all),
-      (str:'RESULT'        ;special:false;keyword:m_none),
-      (str:'STATIC'        ;special:false;keyword:m_none),
-      (str:'STORED'        ;special:false;keyword:m_none),
-      (str:'STRING'        ;special:false;keyword:m_all),
-      (str:'SYSTEM'        ;special:false;keyword:m_none),
-      (str:'ASMNAME'       ;special:false;keyword:m_none),
-      (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_class),
-      (str:'FORWARD'       ;special:false;keyword:m_none),
-      (str:'IOCHECK'       ;special:false;keyword:m_none),
-      (str:'LIBRARY'       ;special:false;keyword:m_all),
-      (str:'MESSAGE'       ;special:false;keyword:m_none),
-      (str:'PRIVATE'       ;special:false;keyword:m_none),
-      (str:'PROGRAM'       ;special:false;keyword:m_all),
-      (str:'STDCALL'       ;special:false;keyword:m_none),
-      (str:'SYSCALL'       ;special:false;keyword:m_none),
-      (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:'POPSTACK'      ;special:false;keyword:m_none),
-      (str:'PROPERTY'      ;special:false;keyword:m_class),
-      (str:'REGISTER'      ;special:false;keyword:m_none),
-      (str:'RESIDENT'      ;special:false;keyword:m_none),
-      (str:'SAFECALL'      ;special:false;keyword:m_none),
-      (str:'ASSEMBLER'     ;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:'THREADVAR'     ;special:false;keyword:m_class),
-      (str:'DESTRUCTOR'    ;special:false;keyword:m_all),
-      (str:'INTERNPROC'    ;special:false;keyword:m_none),
-      (str:'OPENSTRING'    ;special:false;keyword:m_none),
-      (str:'CONSTRUCTOR'   ;special:false;keyword:m_all),
-      (str:'INTERNCONST'   ;special:false;keyword:m_none),
-      (str:'SHORTSTRING'   ;special:false;keyword:m_none),
-      (str:'FINALIZATION'  ;special:false;keyword:m_initfinal),
-      (str:'SAVEREGISTERS' ;special:false;keyword:m_none),
-      (str:'IMPLEMENTATION';special:false;keyword:m_all),
-      (str:'INITIALIZATION';special:false;keyword:m_initfinal),
-      (str:'RESOURCESTRING';special:false;keyword:m_class)
-  );
+  ttokenarray=array[ttoken] of tokenrec;
+  ptokenarray=^ttokenarray;
+
+  tokenidxrec=record
+    first,last : ttoken;
+  end;
+
+  ptokenidx=^ttokenidx;
+  ttokenidx=array[2..tokenidlen,'A'..'Z'] of tokenidxrec;
+
+
+var tokeninfo:ptokenarray;
+    tokenidx:ptokenidx;
+
+procedure inittokens;
+procedure donetokens;
 
 implementation
 
+uses    globals;
+
+procedure inittokens;
+
+var f:file;
+    header:string;
+    a:longint;
+
+begin
+    assign(f,exepath+'tokens.dat');
+    reset(f,1);
+    {We are not sure that the msg file is loaded!}
+    if ioresult<>0 then
+        begin
+            close(f);
+            writeln('Fatal: File tokens.dat not found.');
+            halt(3);
+        end;
+    blockread(f,header,1);
+    blockread(f,header[1],length(header));
+    blockread(f,a,sizeof(a));
+    if (header<>tokheader) or (a<>sizeof(ttokenarray)) then
+        begin
+            close(f);
+            writeln('Fatal: File tokens.dat corrupt.');
+            halt(3);
+        end;
+    new(tokeninfo);
+    blockread(f,tokeninfo^,sizeof(ttokenarray));
+    new(tokenidx);
+    blockread(f,tokenidx^,sizeof(tokenidx^));
+    close(f);
+end;
+
+procedure donetokens;
+
+begin
+    dispose(tokeninfo);
+    dispose(tokenidx);
+end;
+
 end.
 {
   $Log$
-  Revision 1.11  1999-08-04 13:03:17  jonas
+  Revision 1.12  1999-09-02 18:47:49  daniel
+    * Could not compile with TP, some arrays moved to heap
+    * NOAG386BIN default for TP
+    * AG386* files were not compatible with TP, fixed.
+
+  Revision 1.11  1999/08/04 13:03:17  jonas
     * all tokens now start with an underscore
     * PowerPC compiles!!