mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-05-02 15:35:03 +02:00
620 lines
20 KiB
ObjectPascal
620 lines
20 KiB
ObjectPascal
{
|
|
$Id$
|
|
Copyright (c) 1993-98 by Florian Klaempfl
|
|
|
|
This unit does the parsing process
|
|
|
|
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.
|
|
|
|
****************************************************************************
|
|
}
|
|
{$ifdef tp}
|
|
{$E+,N+,D+,F+}
|
|
{$endif}
|
|
unit parser;
|
|
|
|
interface
|
|
|
|
procedure compile(const filename:string;compile_system:boolean);
|
|
procedure initparser;
|
|
|
|
implementation
|
|
|
|
uses
|
|
dos,cobjects,globals,scanner,systems,symtable,tree,aasm,
|
|
types,strings,pass_1,hcodegen,files,verbose,script,import
|
|
{$ifdef i386}
|
|
,i386
|
|
,cgi386
|
|
,cgai386
|
|
,tgeni386
|
|
,aopt386
|
|
{$endif i386}
|
|
{$ifdef m68k}
|
|
,m68k
|
|
,cg68k
|
|
,tgen68k
|
|
,cga68k
|
|
{$endif m68k}
|
|
{ parser units }
|
|
,pbase,pmodules,pdecl,
|
|
{ assembling & linking }
|
|
assemble,
|
|
link;
|
|
|
|
{ dummy variable for search when calling exec }
|
|
var
|
|
file_found : boolean;
|
|
|
|
procedure readconstdefs;
|
|
|
|
begin
|
|
s32bitdef:=porddef(globaldef('longint'));
|
|
u32bitdef:=porddef(globaldef('ulong'));
|
|
cstringdef:=pstringdef(globaldef('string'));
|
|
clongstringdef:=pstringdef(globaldef('longstring'));
|
|
cansistringdef:=pstringdef(globaldef('ansistring'));
|
|
cwidestringdef:=pstringdef(globaldef('widestring'));
|
|
cchardef:=porddef(globaldef('char'));
|
|
{$ifdef i386}
|
|
c64floatdef:=pfloatdef(globaldef('s64real'));
|
|
{$endif}
|
|
{$ifdef m68k}
|
|
c64floatdef:=pfloatdef(globaldef('s32real'));
|
|
{$endif m68k}
|
|
s80floatdef:=pfloatdef(globaldef('s80real'));
|
|
s32fixeddef:=pfloatdef(globaldef('cs32fixed'));
|
|
voiddef:=porddef(globaldef('void'));
|
|
u8bitdef:=porddef(globaldef('byte'));
|
|
u16bitdef:=porddef(globaldef('word'));
|
|
booldef:=porddef(globaldef('boolean'));
|
|
voidpointerdef:=ppointerdef(globaldef('void_pointer'));
|
|
cfiledef:=pfiledef(globaldef('file'));
|
|
end;
|
|
|
|
procedure initparser;
|
|
|
|
begin
|
|
forwardsallowed:=false;
|
|
|
|
{ ^M means a string or a char, because we don't parse a }
|
|
{ type declaration }
|
|
block_type:=bt_general;
|
|
ignore_equal:=false;
|
|
|
|
{ we didn't parse a object or class declaration }
|
|
{ and no function header }
|
|
testcurobject:=0;
|
|
|
|
{ create error defintion }
|
|
generrordef:=new(perrordef,init);
|
|
|
|
symtablestack:=nil;
|
|
|
|
{ a long time, this was forgotten }
|
|
aktprocsym:=nil;
|
|
|
|
current_module:=nil;
|
|
|
|
loaded_units.init;
|
|
|
|
usedunits.init;
|
|
end;
|
|
|
|
{ moved out to save stack }
|
|
var
|
|
addparam : string;
|
|
|
|
procedure compile(const filename:string;compile_system:boolean);
|
|
var
|
|
hp : pmodule;
|
|
|
|
{ some variables to save the compiler state }
|
|
oldtoken : ttoken;
|
|
oldtokenpos : tfileposinfo;
|
|
oldpattern : stringid;
|
|
|
|
oldpreprocstack : ppreprocstack;
|
|
oldorgpattern,oldprocprefix : string;
|
|
old_block_type : tblock_type;
|
|
oldinputbuffer,
|
|
oldinputpointer : pchar;
|
|
olds_point,oldparse_only : boolean;
|
|
oldc : char;
|
|
oldcomment_level : word;
|
|
oldnextlabelnr : longint;
|
|
oldmacros,oldrefsymtable,oldsymtablestack : psymtable;
|
|
|
|
oldimports,oldexports,oldresource,oldrttilist,
|
|
oldbsssegment,olddatasegment,oldcodesegment,
|
|
oldexprasmlist,olddebuglist,
|
|
oldinternals,oldexternals,oldconsts : paasmoutput;
|
|
|
|
oldswitches : tcswitches;
|
|
oldpackrecords : word;
|
|
oldoutputformat : tasm;
|
|
oldoptprocessor : tprocessors;
|
|
oldasmmode : tasmmode;
|
|
|
|
procedure def_macro(const s : string);
|
|
|
|
var
|
|
mac : pmacrosym;
|
|
|
|
begin
|
|
mac:=pmacrosym(macros^.search(s));
|
|
if mac=nil then
|
|
begin
|
|
mac:=new(pmacrosym,init(s));
|
|
Message1(parser_m_macro_defined,mac^.name);
|
|
macros^.insert(mac);
|
|
end;
|
|
mac^.defined:=true;
|
|
end;
|
|
|
|
procedure set_macro(const s : string;value : string);
|
|
|
|
var
|
|
mac : pmacrosym;
|
|
|
|
begin
|
|
mac:=pmacrosym(macros^.search(s));
|
|
if mac=nil then
|
|
begin
|
|
mac:=new(pmacrosym,init(s));
|
|
macros^.insert(mac);
|
|
end
|
|
else
|
|
begin
|
|
if assigned(mac^.buftext) then
|
|
freemem(mac^.buftext,mac^.buflen);
|
|
end;
|
|
Message2(parser_m_macro_set_to,mac^.name,value);
|
|
mac^.buflen:=length(value);
|
|
getmem(mac^.buftext,mac^.buflen);
|
|
move(value[1],mac^.buftext^,mac^.buflen);
|
|
mac^.defined:=true;
|
|
end;
|
|
|
|
procedure define_macros;
|
|
|
|
var
|
|
hp : pstring_item;
|
|
|
|
begin
|
|
hp:=pstring_item(initdefines.first);
|
|
while assigned(hp) do
|
|
begin
|
|
def_macro(hp^.str^);
|
|
hp:=pstring_item(hp^.next);
|
|
end;
|
|
|
|
{ set macros for version checking }
|
|
set_macro('FPC_VERSION',version_nr);
|
|
set_macro('FPC_RELEASE',release_nr);
|
|
set_macro('FPC_PATCH',patch_nr);
|
|
end;
|
|
|
|
label
|
|
done;
|
|
|
|
begin {compile}
|
|
inc(compile_level);
|
|
{ save old state }
|
|
|
|
{ save symtable state }
|
|
oldsymtablestack:=symtablestack;
|
|
symtablestack:=nil;
|
|
oldrefsymtable:=refsymtable;
|
|
refsymtable:=nil;
|
|
oldprocprefix:=procprefix;
|
|
|
|
{ a long time, this was only in init_parser
|
|
but it should be reset to zero for each module }
|
|
aktprocsym:=nil;
|
|
|
|
{ first, we assume a program }
|
|
if not(assigned(current_module)) then
|
|
begin
|
|
current_module:=new(pmodule,init(filename,false));
|
|
main_module:=current_module;
|
|
end;
|
|
|
|
{ save scanner state }
|
|
oldmacros:=macros;
|
|
oldpattern:=pattern;
|
|
oldtoken:=token;
|
|
oldtokenpos:=tokenpos;
|
|
oldorgpattern:=orgpattern;
|
|
old_block_type:=block_type;
|
|
oldpreprocstack:=preprocstack;
|
|
|
|
oldinputbuffer:=inputbuffer;
|
|
oldinputpointer:=inputpointer;
|
|
olds_point:=s_point;
|
|
oldc:=c;
|
|
oldcomment_level:=comment_level;
|
|
|
|
oldnextlabelnr:=nextlabelnr;
|
|
oldparse_only:=parse_only;
|
|
|
|
{ save assembler lists }
|
|
olddatasegment:=datasegment;
|
|
oldbsssegment:=bsssegment;
|
|
oldcodesegment:=codesegment;
|
|
olddebuglist:=debuglist;
|
|
oldexternals:=externals;
|
|
oldinternals:=internals;
|
|
oldconsts:=consts;
|
|
oldrttilist:=rttilist;
|
|
oldexprasmlist:=exprasmlist;
|
|
oldimports:=importssection;
|
|
oldexports:=exportssection;
|
|
oldresource:=resourcesection;
|
|
|
|
{ save the current state }
|
|
oldswitches:=aktswitches;
|
|
oldpackrecords:=aktpackrecords;
|
|
oldoutputformat:=aktoutputformat;
|
|
oldoptprocessor:=aktoptprocessor;
|
|
oldasmmode:=aktasmmode;
|
|
|
|
Message1(parser_i_compiling,filename);
|
|
|
|
InitScanner(filename);
|
|
|
|
{ Load current state from the init values }
|
|
aktswitches:=initswitches;
|
|
aktpackrecords:=initpackrecords;
|
|
aktoutputformat:=initoutputformat;
|
|
aktoptprocessor:=initoptprocessor;
|
|
aktasmmode:=initasmmode;
|
|
|
|
{ we need this to make the system unit }
|
|
if compile_system then
|
|
aktswitches:=aktswitches+[cs_compilesystem];
|
|
|
|
|
|
{ macros }
|
|
macros:=new(psymtable,init(macrosymtable));
|
|
macros^.name:=stringdup('Conditionals for '+filename);
|
|
define_macros;
|
|
|
|
{ startup scanner }
|
|
token:=yylex;
|
|
|
|
{ init code generator for a new module }
|
|
codegen_newmodule;
|
|
{$ifdef GDB}
|
|
reset_gdb_info;
|
|
{$endif GDB}
|
|
{ global switches are read, so further changes aren't allowed }
|
|
current_module^.in_main:=true;
|
|
|
|
{ open assembler response }
|
|
if (compile_level=1) then
|
|
AsmRes.Init('ppas');
|
|
|
|
{ if the current file isn't a system unit }
|
|
{ the the system unit will be loaded }
|
|
if not(cs_compilesystem in aktswitches) then
|
|
begin
|
|
{ should be done in unit system (changing the field system_unit)
|
|
FK
|
|
}
|
|
hp:=loadunit(upper(target_info.system_unit),true,true);
|
|
systemunit:=hp^.symtable;
|
|
make_ref:=false;
|
|
readconstdefs;
|
|
{ we could try to overload caret by default }
|
|
symtablestack:=systemunit;
|
|
{ if POWER is defined in the RTL then use it for starstar overloading }
|
|
getsym('POWER',false);
|
|
if assigned(srsym) and (srsym^.typ=procsym) and
|
|
(overloaded_operators[STARSTAR]=nil) then
|
|
overloaded_operators[STARSTAR]:=pprocsym(srsym);
|
|
make_ref:=true;
|
|
end
|
|
else
|
|
begin
|
|
{ create definitions for constants }
|
|
registerdef:=false;
|
|
s32bitdef:=new(porddef,init(s32bit,$80000000,$7fffffff));
|
|
u32bitdef:=new(porddef,init(u32bit,0,$ffffffff));
|
|
cstringdef:=new(pstringdef,init(255));
|
|
{ should we give a length to the default long and ansi string definition ?? }
|
|
clongstringdef:=new(pstringdef,longinit(-1));
|
|
cansistringdef:=new(pstringdef,ansiinit(-1));
|
|
cwidestringdef:=new(pstringdef,wideinit(-1));
|
|
cchardef:=new(porddef,init(uchar,0,255));
|
|
{$ifdef i386}
|
|
c64floatdef:=new(pfloatdef,init(s64real));
|
|
s80floatdef:=new(pfloatdef,init(s80real));
|
|
{$endif}
|
|
{$ifdef m68k}
|
|
c64floatdef:=new(pfloatdef,init(s32real));
|
|
if (cs_fp_emulation in aktswitches) then
|
|
s80floatdef:=new(pfloatdef,init(s32real))
|
|
else
|
|
s80floatdef:=new(pfloatdef,init(s80real));
|
|
{$endif}
|
|
s32fixeddef:=new(pfloatdef,init(f32bit));
|
|
|
|
{ some other definitions }
|
|
voiddef:=new(porddef,init(uvoid,0,0));
|
|
u8bitdef:=new(porddef,init(u8bit,0,255));
|
|
u16bitdef:=new(porddef,init(u16bit,0,65535));
|
|
booldef:=new(porddef,init(bool8bit,0,1));
|
|
voidpointerdef:=new(ppointerdef,init(voiddef));
|
|
cfiledef:=new(pfiledef,init(ft_untyped,nil));
|
|
systemunit:=nil;
|
|
end;
|
|
registerdef:=true;
|
|
make_ref:=true;
|
|
|
|
{ current return type is void }
|
|
procinfo.retdef:=voiddef;
|
|
|
|
{ reset lexical level }
|
|
lexlevel:=0;
|
|
|
|
{ parse source }
|
|
if (token=_UNIT) or (compile_level>1) then
|
|
begin
|
|
current_module^.is_unit:=true;
|
|
{ If the compile level > 1 we get a nice "unit expected" error
|
|
message if we are trying to use a program as unit.}
|
|
proc_unit;
|
|
if current_module^.compiled then
|
|
goto done;
|
|
end
|
|
else
|
|
begin
|
|
proc_program(token=_LIBRARY);
|
|
end;
|
|
|
|
if status.errorcount=0 then
|
|
begin
|
|
if current_module^.uses_imports then
|
|
importlib^.generatelib;
|
|
|
|
GenerateAsm(filename);
|
|
|
|
if (cs_smartlink in aktswitches) then
|
|
begin
|
|
Linker.SetLibName(current_module^.libfilename^);
|
|
Linker.MakeStaticLibrary(SmartLinkPath(FileName),SmartLinkFilesCnt);
|
|
end;
|
|
|
|
{ add the files for the linker from current_module, this must be
|
|
after the makestaticlibrary, because it will add the library
|
|
name (PFV) }
|
|
addlinkerfiles(current_module);
|
|
|
|
{ Check linking => we are at first level in compile }
|
|
if (compile_level=1) and (not current_module^.is_unit) then
|
|
begin
|
|
if (cs_no_linking in initswitches) then
|
|
externlink:=true;
|
|
if Linker.ExeName='' then
|
|
Linker.SetExeName(FileName);
|
|
Linker.MakeExecutable;
|
|
end;
|
|
end
|
|
else
|
|
Message1(unit_f_errors_in_unit,tostr(status.errorcount));
|
|
done:
|
|
{ clear memory }
|
|
{$ifdef Splitheap}
|
|
if testsplit then
|
|
begin
|
|
{ temp heap should be empty after that !!!}
|
|
codegen_donemodule;
|
|
Releasetempheap;
|
|
end;
|
|
{$endif Splitheap}
|
|
|
|
{ restore old state, close trees }
|
|
if dispose_asm_lists then
|
|
codegen_donemodule;
|
|
|
|
{$ifdef GDB}
|
|
reset_gdb_info;
|
|
{$endif GDB}
|
|
{ restore symtable state }
|
|
{$ifdef UseBrowser}
|
|
if (compile_level>1) then
|
|
{ we want to keep the current symtablestack }
|
|
{$endif UseBrowser}
|
|
begin
|
|
refsymtable:=oldrefsymtable;
|
|
symtablestack:=oldsymtablestack;
|
|
end;
|
|
|
|
procprefix:=oldprocprefix;
|
|
|
|
{ close the inputfiles }
|
|
{$ifdef UseBrowser}
|
|
{ we need the names for the browser ! }
|
|
current_module^.sourcefiles.close_all;
|
|
{$else UseBrowser}
|
|
current_module^.sourcefiles.done;
|
|
{$endif not UseBrowser}
|
|
{ restore scanner state }
|
|
pattern:=oldpattern;
|
|
token:=oldtoken;
|
|
tokenpos:=oldtokenpos;
|
|
orgpattern:=oldorgpattern;
|
|
block_type:=old_block_type;
|
|
|
|
{ call donescanner before restoring preprocstack, because }
|
|
{ donescanner tests for a empty preprocstack }
|
|
{ and can also check for unused macros }
|
|
donescanner(current_module^.compiled);
|
|
dispose(macros,done);
|
|
macros:=oldmacros;
|
|
|
|
{ restore scanner }
|
|
preprocstack:=oldpreprocstack;
|
|
inputbuffer:=oldinputbuffer;
|
|
inputpointer:=oldinputpointer;
|
|
s_point:=olds_point;
|
|
c:=oldc;
|
|
comment_level:=oldcomment_level;
|
|
|
|
nextlabelnr:=oldnextlabelnr;
|
|
parse_only:=oldparse_only;
|
|
|
|
{ restore asmlists }
|
|
exprasmlist:=oldexprasmlist;
|
|
datasegment:=olddatasegment;
|
|
bsssegment:=oldbsssegment;
|
|
codesegment:=oldcodesegment;
|
|
consts:=oldconsts;
|
|
debuglist:=olddebuglist;
|
|
externals:=oldexternals;
|
|
internals:=oldinternals;
|
|
importssection:=oldimports;
|
|
exportssection:=oldexports;
|
|
resourcesection:=oldresource;
|
|
|
|
{ restore current state }
|
|
aktswitches:=oldswitches;
|
|
aktpackrecords:=oldpackrecords;
|
|
aktoutputformat:=oldoutputformat;
|
|
aktoptprocessor:=oldoptprocessor;
|
|
aktasmmode:=oldasmmode;
|
|
|
|
if (compile_level=1) then
|
|
begin
|
|
if (not AsmRes.Empty) then
|
|
begin
|
|
Message1(exec_i_closing_script,AsmRes.Fn);
|
|
AsmRes.WriteToDisk;
|
|
end;
|
|
end;
|
|
dec(compile_level);
|
|
end;
|
|
|
|
end.
|
|
{
|
|
$Log$
|
|
Revision 1.19 1998-05-27 19:45:04 peter
|
|
* symtable.pas splitted into includefiles
|
|
* symtable adapted for $ifdef NEWPPU
|
|
|
|
Revision 1.18 1998/05/23 01:21:15 peter
|
|
+ aktasmmode, aktoptprocessor, aktoutputformat
|
|
+ smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
|
|
+ $LIBNAME to set the library name where the unit will be put in
|
|
* splitted cgi386 a bit (codeseg to large for bp7)
|
|
* nasm, tasm works again. nasm moved to ag386nsm.pas
|
|
|
|
Revision 1.17 1998/05/20 09:42:34 pierre
|
|
+ UseTokenInfo now default
|
|
* unit in interface uses and implementation uses gives error now
|
|
* only one error for unknown symbol (uses lastsymknown boolean)
|
|
the problem came from the label code !
|
|
+ first inlined procedures and function work
|
|
(warning there might be allowed cases were the result is still wrong !!)
|
|
* UseBrower updated gives a global list of all position of all used symbols
|
|
with switch -gb
|
|
|
|
Revision 1.16 1998/05/12 10:47:00 peter
|
|
* moved printstatus to verb_def
|
|
+ V_Normal which is between V_Error and V_Warning and doesn't have a
|
|
prefix like error: warning: and is included in V_Default
|
|
* fixed some messages
|
|
* first time parameter scan is only for -v and -T
|
|
- removed old style messages
|
|
|
|
Revision 1.15 1998/05/11 13:07:54 peter
|
|
+ $ifdef NEWPPU for the new ppuformat
|
|
+ $define GDB not longer required
|
|
* removed all warnings and stripped some log comments
|
|
* no findfirst/findnext anymore to remove smartlink *.o files
|
|
|
|
Revision 1.14 1998/05/06 18:36:53 peter
|
|
* tai_section extended with code,data,bss sections and enumerated type
|
|
* ident 'compiled by FPC' moved to pmodules
|
|
* small fix for smartlink
|
|
|
|
Revision 1.13 1998/05/06 08:38:42 pierre
|
|
* better position info with UseTokenInfo
|
|
UseTokenInfo greatly simplified
|
|
+ added check for changed tree after first time firstpass
|
|
(if we could remove all the cases were it happen
|
|
we could skip all firstpass if firstpasscount > 1)
|
|
Only with ExtDebug
|
|
|
|
Revision 1.12 1998/05/04 17:54:28 peter
|
|
+ smartlinking works (only case jumptable left todo)
|
|
* redesign of systems.pas to support assemblers and linkers
|
|
+ Unitname is now also in the PPU-file, increased version to 14
|
|
|
|
Revision 1.11 1998/05/01 16:38:45 florian
|
|
* handling of private and protected fixed
|
|
+ change_keywords_to_tp implemented to remove
|
|
keywords which aren't supported by tp
|
|
* break and continue are now symbols of the system unit
|
|
+ widestring, longstring and ansistring type released
|
|
|
|
Revision 1.10 1998/05/01 07:43:56 florian
|
|
+ basics for rtti implemented
|
|
+ switch $m (generate rtti for published sections)
|
|
|
|
Revision 1.9 1998/04/30 15:59:40 pierre
|
|
* GDB works again better :
|
|
correct type info in one pass
|
|
+ UseTokenInfo for better source position
|
|
* fixed one remaining bug in scanner for line counts
|
|
* several little fixes
|
|
|
|
Revision 1.8 1998/04/29 10:33:55 pierre
|
|
+ added some code for ansistring (not complete nor working yet)
|
|
* corrected operator overloading
|
|
* corrected nasm output
|
|
+ started inline procedures
|
|
+ added starstarn : use ** for exponentiation (^ gave problems)
|
|
+ started UseTokenInfo cond to get accurate positions
|
|
|
|
Revision 1.7 1998/04/27 23:10:28 peter
|
|
+ new scanner
|
|
* $makelib -> if smartlink
|
|
* small filename fixes pmodule.setfilename
|
|
* moved import from files.pas -> import.pas
|
|
|
|
Revision 1.6 1998/04/21 10:16:48 peter
|
|
* patches from strasbourg
|
|
* objects is not used anymore in the fpc compiled version
|
|
|
|
Revision 1.5 1998/04/10 14:41:43 peter
|
|
* removed some Hints
|
|
* small speed optimization for AsmLn
|
|
|
|
Revision 1.4 1998/04/08 16:58:03 pierre
|
|
* several bugfixes
|
|
ADD ADC and AND are also sign extended
|
|
nasm output OK (program still crashes at end
|
|
and creates wrong assembler files !!)
|
|
procsym types sym in tdef removed !!
|
|
|
|
Revision 1.3 1998/04/07 22:45:04 florian
|
|
* bug0092, bug0115 and bug0121 fixed
|
|
+ packed object/class/array
|
|
}
|
|
|
|
|