paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-16 09:19:35 +02:00
Code Issues Packages Projects Releases Wiki Activity
1777e0c901
fpc/compiler/tokendat.pas
daniel 1777e0c901 * Could not compile with TP, some arrays moved to heap 
* NOAG386BIN default for TP
  * AG386* files were not compatible with TP, fixed.
1999-09-02 18:47:41 +00:00

254 lines
12 KiB
ObjectPascal
Raw Blame History

{
$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.
Reference in New Issue View Git Blame Copy Permalink