paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-16 04:59:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
* NOAG386BIN default for TP
  * AG386* files were not compatible with TP, fixed.
This commit is contained in:
daniel 1999-09-02 18:47:41 +00:00
parent 63ceb87e8f
commit 1777e0c901
12 changed files with 480 additions and 266 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
compiler/Makefile
View File

@ -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

11
compiler/ag386int.pas
View File

@ -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

11
compiler/ag386nsm.pas
View File

@ -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

9
compiler/assemble.pas
View File

@ -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

11
compiler/compiler.pas
View File

@ -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

13
compiler/pbase.pas
View File

@ -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!!

10
compiler/pp.pas
View File

@ -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

15
compiler/psub.pas
View File

@ -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

103
compiler/scandir.inc
View File

@ -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

57
compiler/scanner.pas
View File

@ -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

253
compiler/tokendat.pas Normal file
View File

@ -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.

238
compiler/tokens.pas
View File

@ -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!!