mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-10-31 01:11:29 +01:00 
			
		
		
		
	
		
			
				
	
	
		
			570 lines
		
	
	
		
			19 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
			
		
		
	
	
			570 lines
		
	
	
		
			19 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
| {
 | |
|     Copyright (c) 1998-2002 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.
 | |
| 
 | |
|  ****************************************************************************
 | |
| }
 | |
| unit parser;
 | |
| 
 | |
| {$i fpcdefs.inc}
 | |
| 
 | |
| interface
 | |
| 
 | |
| {$ifdef PREPROCWRITE}
 | |
|     procedure preprocess(const filename:string);
 | |
| {$endif PREPROCWRITE}
 | |
|     procedure compile(const filename:string);
 | |
|     procedure initparser;
 | |
|     procedure doneparser;
 | |
| 
 | |
| implementation
 | |
| 
 | |
|     uses
 | |
| {$IFNDEF USE_FAKE_SYSUTILS}
 | |
|       sysutils,
 | |
| {$ELSE}
 | |
|       fksysutl,
 | |
| {$ENDIF}
 | |
|       cutils,cclasses,
 | |
|       globtype,version,tokens,systems,globals,verbose,
 | |
|       symbase,symtable,symsym,
 | |
|       finput,fmodule,fppu,
 | |
|       aasmbase,aasmtai,aasmdata,
 | |
|       cgbase,
 | |
|       script,gendef,
 | |
| {$ifdef BrowserCol}
 | |
|       browcol,
 | |
| {$endif BrowserCol}
 | |
| {$ifdef BrowserLog}
 | |
|       browlog,
 | |
| {$endif BrowserLog}
 | |
|       comphook,
 | |
|       scanner,scandir,
 | |
|       pbase,ptype,psystem,pmodules,psub,
 | |
|       cresstr,cpuinfo,procinfo;
 | |
| 
 | |
| 
 | |
|     procedure initparser;
 | |
|       begin
 | |
|          { ^M means a string or a char, because we don't parse a }
 | |
|          { type declaration                                      }
 | |
|          ignore_equal:=false;
 | |
| 
 | |
|          { we didn't parse a object or class declaration }
 | |
|          { and no function header                        }
 | |
|          testcurobject:=0;
 | |
| 
 | |
|          { Current compiled module/proc }
 | |
|          current_module:=nil;
 | |
|          compiled_module:=nil;
 | |
|          current_asmdata:=nil;
 | |
|          current_procinfo:=nil;
 | |
|          SetCompileModule(nil);
 | |
| 
 | |
|          loaded_units:=TLinkedList.Create;
 | |
| 
 | |
|          usedunits:=TLinkedList.Create;
 | |
| 
 | |
|          { global switches }
 | |
|          aktglobalswitches:=initglobalswitches;
 | |
| 
 | |
|          aktsourcecodepage:=initsourcecodepage;
 | |
| 
 | |
|          { initialize scanner }
 | |
|          InitScanner;
 | |
|          InitScannerDirectives;
 | |
| 
 | |
|          { scanner }
 | |
|          c:=#0;
 | |
|          pattern:='';
 | |
|          orgpattern:='';
 | |
|          current_scanner:=nil;
 | |
| 
 | |
|          { register all nodes and tais }
 | |
|          registernodes;
 | |
|          registertais;
 | |
| 
 | |
|          { memory sizes }
 | |
|          if stacksize=0 then
 | |
|            stacksize:=target_info.stacksize;
 | |
| 
 | |
|          { open assembler response }
 | |
|          if cs_link_on_target in aktglobalswitches then
 | |
|            GenerateAsmRes(outputexedir+inputfile+'_ppas')
 | |
|          else
 | |
|            GenerateAsmRes(outputexedir+'ppas');
 | |
| 
 | |
|          { open deffile }
 | |
|          DefFile:=TDefFile.Create(outputexedir+inputfile+target_info.defext);
 | |
| 
 | |
|          { list of generated .o files, so the linker can remove them }
 | |
|          SmartLinkOFiles:=TStringList.Create;
 | |
| 
 | |
|          { codegen }
 | |
|          if paraprintnodetree<>0 then
 | |
|            printnode_reset;
 | |
| 
 | |
|          { target specific stuff }
 | |
|          case target_info.system of
 | |
|            system_powerpc_amiga:
 | |
|              include(supported_calling_conventions,pocall_syscall);
 | |
|            system_powerpc_morphos:
 | |
|              include(supported_calling_conventions,pocall_syscall);
 | |
|            system_m68k_amiga:
 | |
|              include(supported_calling_conventions,pocall_syscall);
 | |
|          end;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure doneparser;
 | |
|       begin
 | |
|          { Reset current compiling info, so destroy routines can't
 | |
|            reference the data that might already be destroyed }
 | |
|          current_module:=nil;
 | |
|          compiled_module:=nil;
 | |
|          current_procinfo:=nil;
 | |
|          current_asmdata:=nil;
 | |
|          SetCompileModule(nil);
 | |
| 
 | |
|          { unload units }
 | |
|          if assigned(loaded_units) then
 | |
|            begin
 | |
|              loaded_units.free;
 | |
|              loaded_units:=nil;
 | |
|            end;
 | |
|          if assigned(usedunits) then
 | |
|            begin
 | |
|              usedunits.free;
 | |
|              usedunits:=nil;
 | |
|            end;
 | |
| 
 | |
|          { if there was an error in the scanner, the scanner is
 | |
|            still assinged }
 | |
|          if assigned(current_scanner) then
 | |
|           begin
 | |
|             current_scanner.free;
 | |
|             current_scanner:=nil;
 | |
|           end;
 | |
| 
 | |
|          { close scanner }
 | |
|          DoneScanner;
 | |
| 
 | |
|          { close ppas,deffile }
 | |
|          asmres.free;
 | |
|          deffile.free;
 | |
| 
 | |
|          { free list of .o files }
 | |
|          SmartLinkOFiles.Free;
 | |
|       end;
 | |
| 
 | |
| 
 | |
| 
 | |
| 
 | |
| {$ifdef PREPROCWRITE}
 | |
|     procedure preprocess(const filename:string);
 | |
|       var
 | |
|         i : longint;
 | |
|       begin
 | |
|          new(preprocfile,init('pre'));
 | |
|        { initialize a module }
 | |
|          current_module:=new(pmodule,init(filename,false));
 | |
| 
 | |
|          macrosymtablestack:= initialmacrosymtable;
 | |
|          current_module.localmacrosymtable:= tmacrosymtable.create(false);
 | |
|          current_module.localmacrosymtable.next:= initialmacrosymtable;
 | |
|          macrosymtablestack:= current_module.localmacrosymtable;
 | |
| 
 | |
|          main_module:=current_module;
 | |
|        { startup scanner, and save in current_module }
 | |
|          current_scanner:=new(pscannerfile,Init(filename));
 | |
|          current_module.scanner:=current_scanner;
 | |
|        { loop until EOF is found }
 | |
|          repeat
 | |
|            current_scanner^.readtoken(true);
 | |
|            preprocfile^.AddSpace;
 | |
|            case token of
 | |
|              _ID :
 | |
|                begin
 | |
|                  preprocfile^.Add(orgpattern);
 | |
|                end;
 | |
|              _REALNUMBER,
 | |
|              _INTCONST :
 | |
|                preprocfile^.Add(pattern);
 | |
|              _CSTRING :
 | |
|                begin
 | |
|                  i:=0;
 | |
|                  while (i<length(pattern)) do
 | |
|                   begin
 | |
|                     inc(i);
 | |
|                     if pattern[i]='''' then
 | |
|                      begin
 | |
|                        insert('''',pattern,i);
 | |
|                        inc(i);
 | |
|                      end;
 | |
|                   end;
 | |
|                  preprocfile^.Add(''''+pattern+'''');
 | |
|                end;
 | |
|              _CCHAR :
 | |
|                begin
 | |
|                  case pattern[1] of
 | |
|                    #39 :
 | |
|                      pattern:='''''''';
 | |
|                    #0..#31,
 | |
|                    #128..#255 :
 | |
|                      begin
 | |
|                        str(ord(pattern[1]),pattern);
 | |
|                        pattern:='#'+pattern;
 | |
|                      end;
 | |
|                    else
 | |
|                      pattern:=''''+pattern[1]+'''';
 | |
|                  end;
 | |
|                  preprocfile^.Add(pattern);
 | |
|                end;
 | |
|              _EOF :
 | |
|                break;
 | |
|              else
 | |
|                preprocfile^.Add(tokeninfo^[token].str)
 | |
|            end;
 | |
|          until false;
 | |
|        { free scanner }
 | |
|          dispose(current_scanner,done);
 | |
|          current_scanner:=nil;
 | |
|        { close }
 | |
|          dispose(preprocfile,done);
 | |
|       end;
 | |
| {$endif PREPROCWRITE}
 | |
| 
 | |
| 
 | |
| {*****************************************************************************
 | |
|                              Compile a source file
 | |
| *****************************************************************************}
 | |
| 
 | |
|     procedure compile(const filename:string);
 | |
|       type
 | |
|         polddata=^tolddata;
 | |
|         tolddata=record
 | |
|         { scanner }
 | |
|           oldidtoken,
 | |
|           oldtoken       : ttoken;
 | |
|           oldtokenpos    : tfileposinfo;
 | |
|           oldc           : char;
 | |
|           oldpattern,
 | |
|           oldorgpattern  : string;
 | |
|           old_block_type : tblock_type;
 | |
|         { symtable }
 | |
|           oldsymtablestack,
 | |
|           oldmacrosymtablestack : tsymtablestack;
 | |
|           oldaktprocsym    : tprocsym;
 | |
|         { cg }
 | |
|           oldparse_only  : boolean;
 | |
|         { akt.. things }
 | |
|           oldaktlocalswitches  : tlocalswitches;
 | |
|           oldaktmoduleswitches : tmoduleswitches;
 | |
|           oldaktfilepos      : tfileposinfo;
 | |
|           oldaktpackrecords,
 | |
|           oldaktpackenum       : shortint;
 | |
|           oldaktmaxfpuregisters : longint;
 | |
|           oldaktalignment    : talignmentinfo;
 | |
|           oldaktoptimizecputype,
 | |
|           oldaktcputype      : tcputype;
 | |
|           oldaktfputype      : tfputype;
 | |
|           oldaktasmmode      : tasmmode;
 | |
|           oldaktinterfacetype: tinterfacetypes;
 | |
|           oldaktmodeswitches : tmodeswitches;
 | |
|           oldaktoptimizerswitches : toptimizerswitches;
 | |
|           old_compiled_module : tmodule;
 | |
|           oldcurrent_procinfo : tprocinfo;
 | |
|           oldaktdefproccall : tproccalloption;
 | |
|           oldsourcecodepage : tcodepagestring;
 | |
|         end;
 | |
| 
 | |
|       var
 | |
|          olddata : polddata;
 | |
|        begin
 | |
|          inc(compile_level);
 | |
|          parser_current_file:=filename;
 | |
|          { Uses heap memory instead of placing everything on the
 | |
|            stack. This is needed because compile() can be called
 | |
|            recursively }
 | |
|          new(olddata);
 | |
|          with olddata^ do
 | |
|           begin
 | |
|             old_compiled_module:=compiled_module;
 | |
|           { save symtable state }
 | |
|             oldsymtablestack:=symtablestack;
 | |
|             oldmacrosymtablestack:=macrosymtablestack;
 | |
|             oldcurrent_procinfo:=current_procinfo;
 | |
|             oldaktdefproccall:=aktdefproccall;
 | |
|           { save scanner state }
 | |
|             oldc:=c;
 | |
|             oldpattern:=pattern;
 | |
|             oldorgpattern:=orgpattern;
 | |
|             oldtoken:=token;
 | |
|             oldidtoken:=idtoken;
 | |
|             old_block_type:=block_type;
 | |
|             oldtokenpos:=akttokenpos;
 | |
|             oldsourcecodepage:=aktsourcecodepage;
 | |
|           { save cg }
 | |
|             oldparse_only:=parse_only;
 | |
|           { save akt... state }
 | |
|           { handle the postponed case first }
 | |
|            if localswitcheschanged then
 | |
|              begin
 | |
|                aktlocalswitches:=nextaktlocalswitches;
 | |
|                localswitcheschanged:=false;
 | |
|              end;
 | |
|             oldaktlocalswitches:=aktlocalswitches;
 | |
|             oldaktmoduleswitches:=aktmoduleswitches;
 | |
|             oldaktalignment:=aktalignment;
 | |
|             oldaktpackenum:=aktpackenum;
 | |
|             oldaktpackrecords:=aktpackrecords;
 | |
|             oldaktfputype:=aktfputype;
 | |
|             oldaktmaxfpuregisters:=aktmaxfpuregisters;
 | |
|             oldaktcputype:=aktcputype;
 | |
|             oldaktoptimizecputype:=aktoptimizecputype;
 | |
|             oldaktasmmode:=aktasmmode;
 | |
|             oldaktinterfacetype:=aktinterfacetype;
 | |
|             oldaktfilepos:=aktfilepos;
 | |
|             oldaktmodeswitches:=aktmodeswitches;
 | |
|             oldaktoptimizerswitches:=aktoptimizerswitches;
 | |
|           end;
 | |
|        { reset parser, a previous fatal error could have left these variables in an unreliable state, this is
 | |
|          important for the IDE }
 | |
|          afterassignment:=false;
 | |
|          in_args:=false;
 | |
|          got_addrn:=false;
 | |
|          getprocvardef:=nil;
 | |
| 
 | |
|        { show info }
 | |
|          Message1(parser_i_compiling,filename);
 | |
| 
 | |
|        { reset symtable }
 | |
|          symtablestack:=tsymtablestack.create;
 | |
|          macrosymtablestack:=tsymtablestack.create;
 | |
|          systemunit:=nil;
 | |
|          aktdefproccall:=initdefproccall;
 | |
|          aktexceptblock:=0;
 | |
|          exceptblockcounter:=0;
 | |
|          aktmaxfpuregisters:=-1;
 | |
|        { reset the unit or create a new program }
 | |
|          { a unit compiled at command line must be inside the loaded_unit list }
 | |
|          if (compile_level=1) then
 | |
|            begin
 | |
|              if assigned(current_module) then
 | |
|                internalerror(200501158);
 | |
|              current_module:=tppumodule.create(nil,filename,'',false);
 | |
|              addloadedunit(current_module);
 | |
|              main_module:=current_module;
 | |
|              current_module.state:=ms_compile;
 | |
|            end;
 | |
|          if not(assigned(current_module) and
 | |
|                 (current_module.state in [ms_compile,ms_second_compile])) then
 | |
|            internalerror(200212281);
 | |
| 
 | |
|          { Set the module to use for verbose }
 | |
|          compiled_module:=current_module;
 | |
|          SetCompileModule(current_module);
 | |
|          Fillchar(aktfilepos,0,sizeof(aktfilepos));
 | |
| 
 | |
|          { Load current state from the init values }
 | |
|          aktlocalswitches:=initlocalswitches;
 | |
|          aktmoduleswitches:=initmoduleswitches;
 | |
|          aktmodeswitches:=initmodeswitches;
 | |
|          aktoptimizerswitches:=initoptimizerswitches;
 | |
|          aktsetalloc:=initsetalloc;
 | |
|          aktalignment:=initalignment;
 | |
|          aktfputype:=initfputype;
 | |
|          aktpackenum:=initpackenum;
 | |
|          aktpackrecords:=0;
 | |
|          aktcputype:=initcputype;
 | |
|          aktoptimizecputype:=initoptimizecputype;
 | |
|          aktasmmode:=initasmmode;
 | |
|          aktinterfacetype:=initinterfacetype;
 | |
| 
 | |
|          { load current asmdata from current_module }
 | |
|          current_asmdata:=TAsmData(current_module.asmdata);
 | |
| 
 | |
|          { startup scanner and load the first file }
 | |
|          current_scanner:=tscannerfile.Create(filename);
 | |
|          current_scanner.firstfile;
 | |
|          current_module.scanner:=current_scanner;
 | |
| 
 | |
|          { init macros before anything in the file is parsed.}
 | |
|          current_module.localmacrosymtable:= tmacrosymtable.create(false);
 | |
|          macrosymtablestack.push(initialmacrosymtable);
 | |
|          macrosymtablestack.push(current_module.localmacrosymtable);
 | |
| 
 | |
|          { read the first token }
 | |
|          current_scanner.readtoken(false);
 | |
| 
 | |
|          { If the compile level > 1 we get a nice "unit expected" error
 | |
|            message if we are trying to use a program as unit.}
 | |
|          try
 | |
|            try
 | |
|              if (token=_UNIT) or (compile_level>1) then
 | |
|                begin
 | |
|                  current_module.is_unit:=true;
 | |
|                  proc_unit;
 | |
|                end
 | |
|              else
 | |
|                proc_program(token=_LIBRARY);
 | |
|            except
 | |
|              on ECompilerAbort do
 | |
|                raise;
 | |
|              on Exception do
 | |
|                begin
 | |
|                  { Increase errorcounter to prevent some
 | |
|                    checks during cleanup }
 | |
|                  inc(status.errorcount);
 | |
|                  raise;
 | |
|                end;
 | |
|            end;
 | |
|          finally
 | |
|            if assigned(current_module) then
 | |
|              begin
 | |
|                { module is now compiled }
 | |
|                tppumodule(current_module).state:=ms_compiled;
 | |
| 
 | |
|                { free ppu }
 | |
|                if assigned(tppumodule(current_module).ppufile) then
 | |
|                  begin
 | |
|                    tppumodule(current_module).ppufile.free;
 | |
|                    tppumodule(current_module).ppufile:=nil;
 | |
|                  end;
 | |
| 
 | |
|                { free asmdata }
 | |
|                if assigned(current_module.asmdata) then
 | |
|                  begin
 | |
|                    current_module.asmdata.free;
 | |
|                    current_module.asmdata:=nil;
 | |
|                  end;
 | |
| 
 | |
|                { free scanner }
 | |
|                if assigned(current_module.scanner) then
 | |
|                  begin
 | |
|                    if current_scanner=tscannerfile(current_module.scanner) then
 | |
|                      current_scanner:=nil;
 | |
|                    tscannerfile(current_module.scanner).free;
 | |
|                    current_module.scanner:=nil;
 | |
|                  end;
 | |
| 
 | |
|                { free symtable stack }
 | |
|                if assigned(symtablestack) then
 | |
|                  begin
 | |
|                    symtablestack.free;
 | |
|                    symtablestack:=nil;
 | |
|                  end;
 | |
|                if assigned(macrosymtablestack) then
 | |
|                  begin
 | |
|                    macrosymtablestack.free;
 | |
|                    macrosymtablestack:=nil;
 | |
|                  end;
 | |
|              end;
 | |
| 
 | |
|             with olddata^ do
 | |
|               begin
 | |
|                 { restore scanner }
 | |
|                 c:=oldc;
 | |
|                 pattern:=oldpattern;
 | |
|                 orgpattern:=oldorgpattern;
 | |
|                 token:=oldtoken;
 | |
|                 idtoken:=oldidtoken;
 | |
|                 akttokenpos:=oldtokenpos;
 | |
|                 block_type:=old_block_type;
 | |
|                 { restore cg }
 | |
|                 parse_only:=oldparse_only;
 | |
|                 { asm data }
 | |
|                 if assigned(old_compiled_module) then
 | |
|                   current_asmdata:=tasmdata(old_compiled_module.asmdata)
 | |
|                 else
 | |
|                   current_asmdata:=nil;
 | |
|                 { restore previous scanner }
 | |
|                 if assigned(old_compiled_module) then
 | |
|                   current_scanner:=tscannerfile(old_compiled_module.scanner)
 | |
|                 else
 | |
|                   current_scanner:=nil;
 | |
|                 if assigned(current_scanner) then
 | |
|                   parser_current_file:=current_scanner.inputfile.name^;
 | |
|                 { restore symtable state }
 | |
|                 symtablestack:=oldsymtablestack;
 | |
|                 macrosymtablestack:=oldmacrosymtablestack;
 | |
|                 aktdefproccall:=oldaktdefproccall;
 | |
|                 current_procinfo:=oldcurrent_procinfo;
 | |
|                 aktsourcecodepage:=oldsourcecodepage;
 | |
|                 aktlocalswitches:=oldaktlocalswitches;
 | |
|                 aktmoduleswitches:=oldaktmoduleswitches;
 | |
|                 aktalignment:=oldaktalignment;
 | |
|                 aktpackenum:=oldaktpackenum;
 | |
|                 aktpackrecords:=oldaktpackrecords;
 | |
|                 aktmaxfpuregisters:=oldaktmaxfpuregisters;
 | |
|                 aktcputype:=oldaktcputype;
 | |
|                 aktoptimizecputype:=oldaktoptimizecputype;
 | |
|                 aktfputype:=oldaktfputype;
 | |
|                 aktasmmode:=oldaktasmmode;
 | |
|                 aktinterfacetype:=oldaktinterfacetype;
 | |
|                 aktfilepos:=oldaktfilepos;
 | |
|                 aktmodeswitches:=oldaktmodeswitches;
 | |
|                 aktoptimizerswitches:=oldaktoptimizerswitches;
 | |
|                 aktexceptblock:=0;
 | |
|                 exceptblockcounter:=0;
 | |
|               end;
 | |
|             { Shut down things when the last file is compiled succesfull }
 | |
|             if (compile_level=1) and
 | |
|                 (status.errorcount=0) then
 | |
|               begin
 | |
|                 parser_current_file:='';
 | |
|                 { Close script }
 | |
|                 if (not AsmRes.Empty) then
 | |
|                 begin
 | |
|                   Message1(exec_i_closing_script,AsmRes.Fn);
 | |
|                   AsmRes.WriteToDisk;
 | |
|                 end;
 | |
| 
 | |
|                 { do not create browsers on errors !! }
 | |
|                 if status.errorcount=0 then
 | |
|                 begin
 | |
| {$ifdef BrowserLog}
 | |
|                   { Write Browser Log }
 | |
|                   if (cs_browser_log in aktglobalswitches) and
 | |
|                       (cs_browser in aktmoduleswitches) then
 | |
|                     begin
 | |
|                       if browserlog.elements_to_list.empty then
 | |
|                       begin
 | |
|                         Message1(parser_i_writing_browser_log,browserlog.Fname);
 | |
|                         WriteBrowserLog;
 | |
|                       end
 | |
|                       else
 | |
|                       browserlog.list_elements;
 | |
|                     end;
 | |
| {$endif BrowserLog}
 | |
|                   { Write Browser Collections, also used by the TextMode IDE to
 | |
|                     retrieve a list of sourcefiles }
 | |
|                   do_extractsymbolinfo();
 | |
|                 end;
 | |
|               end;
 | |
| 
 | |
|            dec(compile_level);
 | |
|            compiled_module:=olddata^.old_compiled_module;
 | |
|            SetCompileModule(compiled_module);
 | |
| 
 | |
|            dispose(olddata);
 | |
|          end;
 | |
|     end;
 | |
| 
 | |
| end.
 | 
