mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-10-27 23:31:50 +01:00 
			
		
		
		
	
		
			
				
	
	
		
			1482 lines
		
	
	
		
			44 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
			
		
		
	
	
			1482 lines
		
	
	
		
			44 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
| {
 | |
|     Copyright (c) 1998-2004 by Peter Vreman
 | |
| 
 | |
|     This unit handles the assemblerfile write and assembler calls of FPC
 | |
| 
 | |
|     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.
 | |
| 
 | |
|  ****************************************************************************
 | |
| }
 | |
| {# @abstract(This unit handles the assembler file write and assembler calls of FPC)
 | |
|    Handles the calls to the actual external assemblers, as well as the generation
 | |
|    of object files for smart linking. Also contains the base class for writing
 | |
|    the assembler statements to file.
 | |
| }
 | |
| unit assemble;
 | |
| 
 | |
| {$i fpcdefs.inc}
 | |
| 
 | |
| interface
 | |
| 
 | |
| 
 | |
|     uses
 | |
| {$IFDEF USE_SYSUTILS}
 | |
|       sysutils,
 | |
| {$ELSE USE_SYSUTILS}
 | |
|       strings,
 | |
|       dos,
 | |
| {$ENDIF USE_SYSUTILS}
 | |
|       systems,globtype,globals,aasmbase,aasmtai,ogbase;
 | |
| 
 | |
|     const
 | |
|        { maximum of aasmoutput lists there will be }
 | |
|        maxoutputlists = 20;
 | |
|        { buffer size for writing the .s file }
 | |
|        AsmOutSize=32768;
 | |
| 
 | |
|     type
 | |
|       TAssembler=class(TAbstractAssembler)
 | |
|       public
 | |
|       {filenames}
 | |
|         path     : pathstr;
 | |
|         name     : namestr;
 | |
|         asmfile,         { current .s and .o file }
 | |
|         objfile  : string;
 | |
|         ppufilename : string;
 | |
|         asmprefix : string;
 | |
|         SmartAsm : boolean;
 | |
|         SmartFilesCount,
 | |
|         SmartHeaderCount : longint;
 | |
|         Constructor Create(smart:boolean);virtual;
 | |
|         Destructor Destroy;override;
 | |
|         procedure NextSmartName(place:tcutplace);
 | |
|         procedure MakeObject;virtual;abstract;
 | |
|       end;
 | |
| 
 | |
|       {# This is the base class which should be overriden for each each
 | |
|          assembler writer. It is used to actually assembler a file,
 | |
|          and write the output to the assembler file.
 | |
|       }
 | |
|       TExternalAssembler=class(TAssembler)
 | |
|       private
 | |
|         procedure CreateSmartLinkPath(const s:string);
 | |
|       protected
 | |
|       {outfile}
 | |
|         AsmSize,
 | |
|         AsmStartSize,
 | |
|         outcnt   : longint;
 | |
|         outbuf   : array[0..AsmOutSize-1] of char;
 | |
|         outfile  : file;
 | |
|         ioerror : boolean;
 | |
|       public
 | |
|         {# Returns the complete path and executable name of the assembler
 | |
|            program.
 | |
| 
 | |
|            It first tries looking in the UTIL directory if specified,
 | |
|            otherwise it searches in the free pascal binary directory, in
 | |
|            the current working directory and then in the  directories
 | |
|            in the $PATH environment.}
 | |
|         Function  FindAssembler:string;
 | |
| 
 | |
|         {# Actually does the call to the assembler file. Returns false
 | |
|            if the assembling of the file failed.}
 | |
|         Function  CallAssembler(const command:string; const para:TCmdStr):Boolean;
 | |
| 
 | |
|         Function  DoAssemble:boolean;virtual;
 | |
|         Procedure RemoveAsm;
 | |
|         Procedure AsmFlush;
 | |
|         Procedure AsmClear;
 | |
| 
 | |
|         {# Write a string to the assembler file }
 | |
|         Procedure AsmWrite(const s:string);
 | |
| 
 | |
|         {# Write a string to the assembler file }
 | |
|         Procedure AsmWritePChar(p:pchar);
 | |
| 
 | |
|         {# Write a string to the assembler file followed by a new line }
 | |
|         Procedure AsmWriteLn(const s:string);
 | |
| 
 | |
|         {# Write a new line to the assembler file }
 | |
|         Procedure AsmLn;
 | |
| 
 | |
|         procedure AsmCreate(Aplace:tcutplace);
 | |
|         procedure AsmClose;
 | |
| 
 | |
|         {# This routine should be overriden for each assembler, it is used
 | |
|            to actually write the abstract assembler stream to file.}
 | |
|         procedure WriteTree(p:TAAsmoutput);virtual;
 | |
| 
 | |
|         {# This routine should be overriden for each assembler, it is used
 | |
|            to actually write all the different abstract assembler streams
 | |
|            by calling for each stream type, the @var(WriteTree) method.}
 | |
|         procedure WriteAsmList;virtual;
 | |
|       public
 | |
|         Constructor Create(smart:boolean);override;
 | |
|         procedure MakeObject;override;
 | |
|       end;
 | |
| 
 | |
|       TInternalAssembler=class(TAssembler)
 | |
|       public
 | |
|         constructor create(smart:boolean);override;
 | |
|         destructor  destroy;override;
 | |
|         procedure MakeObject;override;
 | |
|       protected
 | |
|         objectdata   : TAsmObjectData;
 | |
|         objectoutput : tobjectoutput;
 | |
|       private
 | |
|         { the aasmoutput lists that need to be processed }
 | |
|         lists        : byte;
 | |
|         list         : array[1..maxoutputlists] of TAAsmoutput;
 | |
|         { current processing }
 | |
|         currlistidx  : byte;
 | |
|         currlist     : TAAsmoutput;
 | |
|         currpass     : byte;
 | |
|         procedure convertstab(p:pchar);
 | |
|         function  MaybeNextList(var hp:Tai):boolean;
 | |
|         function  TreePass0(hp:Tai):Tai;
 | |
|         function  TreePass1(hp:Tai):Tai;
 | |
|         function  TreePass2(hp:Tai):Tai;
 | |
|         procedure writetree;
 | |
|         procedure writetreesmart;
 | |
|       end;
 | |
| 
 | |
|     TAssemblerClass = class of TAssembler;
 | |
| 
 | |
|     Procedure GenerateAsm(smart:boolean);
 | |
|     Procedure OnlyAsm;
 | |
| 
 | |
|     procedure RegisterAssembler(const r:tasminfo;c:TAssemblerClass);
 | |
|     procedure InitAssembler;
 | |
|     procedure DoneAssembler;
 | |
| 
 | |
| 
 | |
| Implementation
 | |
| 
 | |
|     uses
 | |
| {$ifdef hasunix}
 | |
|   {$ifdef havelinuxrtl10}
 | |
|       linux,
 | |
|   {$else}
 | |
|       unix,
 | |
|   {$endif}
 | |
| {$endif}
 | |
|       cutils,script,fmodule,verbose,
 | |
| {$ifdef memdebug}
 | |
|       cclasses,
 | |
| {$endif memdebug}
 | |
| {$ifdef m68k}
 | |
|       cpuinfo,
 | |
| {$endif m68k}
 | |
|       aasmcpu
 | |
|       ;
 | |
| 
 | |
|     var
 | |
|       CAssembler : array[tasm] of TAssemblerClass;
 | |
| 
 | |
| 
 | |
| {*****************************************************************************
 | |
|                                    TAssembler
 | |
| *****************************************************************************}
 | |
| 
 | |
|     Constructor TAssembler.Create(smart:boolean);
 | |
|       begin
 | |
|       { load start values }
 | |
|         asmfile:=current_module.get_asmfilename;
 | |
|         objfile:=current_module.objfilename^;
 | |
|         name:=Lower(current_module.modulename^);
 | |
|         path:=current_module.outputpath^;
 | |
|         asmprefix := current_module.asmprefix^;
 | |
|         if not assigned(current_module.outputpath) then
 | |
|           ppufilename := ''
 | |
|         else
 | |
|           ppufilename := current_module.ppufilename^;
 | |
|         SmartAsm:=smart;
 | |
|         SmartFilesCount:=0;
 | |
|         SmartHeaderCount:=0;
 | |
|         SmartLinkOFiles.Clear;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     Destructor TAssembler.Destroy;
 | |
|       begin
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TAssembler.NextSmartName(place:tcutplace);
 | |
|       var
 | |
|         s : string;
 | |
|       begin
 | |
|         inc(SmartFilesCount);
 | |
|         if SmartFilesCount>999999 then
 | |
|          Message(asmw_f_too_many_asm_files);
 | |
|         case place of
 | |
|           cut_begin :
 | |
|             begin
 | |
|               inc(SmartHeaderCount);
 | |
|               s:=asmprefix+tostr(SmartHeaderCount)+'h';
 | |
|             end;
 | |
|           cut_normal :
 | |
|             s:=asmprefix+tostr(SmartHeaderCount)+'s';
 | |
|           cut_end :
 | |
|             s:=asmprefix+tostr(SmartHeaderCount)+'t';
 | |
|         end;
 | |
|         AsmFile:=Path+FixFileName(s+tostr(SmartFilesCount)+target_info.asmext);
 | |
|         ObjFile:=Path+FixFileName(s+tostr(SmartFilesCount)+target_info.objext);
 | |
|         { insert in container so it can be cleared after the linking }
 | |
|         SmartLinkOFiles.Insert(Objfile);
 | |
|       end;
 | |
| 
 | |
| 
 | |
| {*****************************************************************************
 | |
|                                  TExternalAssembler
 | |
| *****************************************************************************}
 | |
| 
 | |
|     Function DoPipe:boolean;
 | |
|       begin
 | |
|         DoPipe:=(cs_asm_pipe in aktglobalswitches) and
 | |
|                 not(cs_asm_leave in aktglobalswitches)
 | |
|                 and ((target_asm.id in [as_gas,as_darwin]));
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     Constructor TExternalAssembler.Create(smart:boolean);
 | |
|       begin
 | |
|         inherited Create(smart);
 | |
|         if SmartAsm then
 | |
|          begin
 | |
|            path:=FixPath(path+FixFileName(name)+target_info.smartext,false);
 | |
|            CreateSmartLinkPath(path);
 | |
|          end;
 | |
|         Outcnt:=0;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TExternalAssembler.CreateSmartLinkPath(const s:string);
 | |
|       var
 | |
| {$IFDEF USE_SYSUTILS}
 | |
|         dir : TSearchRec;
 | |
| {$ELSE USE_SYSUTILS}
 | |
|         dir : searchrec;
 | |
| {$ENDIF USE_SYSUTILS}
 | |
|         hs  : string;
 | |
|       begin
 | |
|         if PathExists(s) then
 | |
|          begin
 | |
|            { the path exists, now we clean only all the .o and .s files }
 | |
|            { .o files }
 | |
| {$IFDEF USE_SYSUTILS}
 | |
|            if findfirst(s+source_info.dirsep+'*'+target_info.objext,faAnyFile,dir) = 0
 | |
|            then repeat
 | |
|               RemoveFile(s+source_info.dirsep+dir.name);
 | |
|            until findnext(dir) <> 0;
 | |
| {$ELSE USE_SYSUTILS}
 | |
|            findfirst(s+source_info.dirsep+'*'+target_info.objext,anyfile,dir);
 | |
|            while (doserror=0) do
 | |
|             begin
 | |
|               RemoveFile(s+source_info.dirsep+dir.name);
 | |
|               findnext(dir);
 | |
|             end;
 | |
| {$ENDIF USE_SYSUTILS}
 | |
|            findclose(dir);
 | |
|            { .s files }
 | |
| {$IFDEF USE_SYSUTILS}
 | |
|            if findfirst(s+source_info.dirsep+'*'+target_info.asmext,faAnyFile,dir) = 0
 | |
|            then repeat
 | |
|              RemoveFile(s+source_info.dirsep+dir.name);
 | |
|            until findnext(dir) <> 0;
 | |
| {$ELSE USE_SYSUTILS}
 | |
|            findfirst(s+source_info.dirsep+'*'+target_info.asmext,anyfile,dir);
 | |
|            while (doserror=0) do
 | |
|             begin
 | |
|               RemoveFile(s+source_info.dirsep+dir.name);
 | |
|               findnext(dir);
 | |
|             end;
 | |
| {$ENDIF USE_SYSUTILS}
 | |
|            findclose(dir);
 | |
|          end
 | |
|         else
 | |
|          begin
 | |
|            hs:=s;
 | |
|            if hs[length(hs)] in ['/','\'] then
 | |
|             delete(hs,length(hs),1);
 | |
|            {$I-}
 | |
|             mkdir(hs);
 | |
|            {$I+}
 | |
|            if ioresult<>0 then;
 | |
|          end;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     const
 | |
|       lastas  : byte=255;
 | |
|     var
 | |
|       LastASBin : pathstr;
 | |
|     Function TExternalAssembler.FindAssembler:string;
 | |
|       var
 | |
|         asfound : boolean;
 | |
|         UtilExe  : string;
 | |
|       begin
 | |
|         asfound:=false;
 | |
|         if cs_link_on_target in aktglobalswitches then
 | |
|          begin
 | |
|            { If linking on target, don't add any path PM }
 | |
|            FindAssembler:=utilsprefix+AddExtension(target_asm.asmbin,target_info.exeext);
 | |
|            exit;
 | |
|          end
 | |
|         else
 | |
|          UtilExe:=utilsprefix+AddExtension(target_asm.asmbin,source_info.exeext);
 | |
|         if lastas<>ord(target_asm.id) then
 | |
|          begin
 | |
|            lastas:=ord(target_asm.id);
 | |
|            { is an assembler passed ? }
 | |
|            if utilsdirectory<>'' then
 | |
|              asfound:=FindFile(UtilExe,utilsdirectory,LastASBin);
 | |
|            if not AsFound then
 | |
|              asfound:=FindExe(UtilExe,LastASBin);
 | |
|            if (not asfound) and not(cs_asm_extern in aktglobalswitches) then
 | |
|             begin
 | |
|               Message1(exec_e_assembler_not_found,LastASBin);
 | |
|               aktglobalswitches:=aktglobalswitches+[cs_asm_extern];
 | |
|             end;
 | |
|            if asfound then
 | |
|             Message1(exec_t_using_assembler,LastASBin);
 | |
|          end;
 | |
|         FindAssembler:=LastASBin;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     Function TExternalAssembler.CallAssembler(const command:string; const para:TCmdStr):Boolean;
 | |
| {$IFDEF USE_SYSUTILS}
 | |
|       var
 | |
|         DosExitCode:Integer;
 | |
| {$ENDIF USE_SYSUTILS}
 | |
|       begin
 | |
|         callassembler:=true;
 | |
|         if not(cs_asm_extern in aktglobalswitches) then
 | |
| {$IFDEF USE_SYSUTILS}
 | |
|         try
 | |
|           DosExitCode := ExecuteProcess(command,para);
 | |
|           if DosExitCode <>0
 | |
|           then begin
 | |
|             Message1(exec_e_error_while_assembling,tostr(dosexitcode));
 | |
|             callassembler:=false;
 | |
|           end;
 | |
|         except on E:EOSError do
 | |
|           begin
 | |
|             Message1(exec_e_cant_call_assembler,tostr(E.ErrorCode));
 | |
|             aktglobalswitches:=aktglobalswitches+[cs_asm_extern];
 | |
|             callassembler:=false;
 | |
|           end
 | |
|         end
 | |
| {$ELSE USE_SYSUTILS}
 | |
|          begin
 | |
|            swapvectors;
 | |
|            exec(maybequoted(command),para);
 | |
|            swapvectors;
 | |
|            if (doserror<>0) then
 | |
|             begin
 | |
|               Message1(exec_e_cant_call_assembler,tostr(doserror));
 | |
|               aktglobalswitches:=aktglobalswitches+[cs_asm_extern];
 | |
|               callassembler:=false;
 | |
|             end
 | |
|            else
 | |
|             if (dosexitcode<>0) then
 | |
|              begin
 | |
|               Message1(exec_e_error_while_assembling,tostr(dosexitcode));
 | |
|               callassembler:=false;
 | |
|              end;
 | |
|          end
 | |
| {$ENDIF USE_SYSUTILS}
 | |
|         else
 | |
|          AsmRes.AddAsmCommand(command,para,name);
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TExternalAssembler.RemoveAsm;
 | |
|       var
 | |
|         g : file;
 | |
|       begin
 | |
|         if cs_asm_leave in aktglobalswitches then
 | |
|          exit;
 | |
|         if cs_asm_extern in aktglobalswitches then
 | |
|          AsmRes.AddDeleteCommand(AsmFile)
 | |
|         else
 | |
|          begin
 | |
|            assign(g,AsmFile);
 | |
|            {$I-}
 | |
|             erase(g);
 | |
|            {$I+}
 | |
|            if ioresult<>0 then;
 | |
|          end;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     Function TExternalAssembler.DoAssemble:boolean;
 | |
|       var
 | |
|         s : TCmdStr;
 | |
|       begin
 | |
|         DoAssemble:=true;
 | |
|         if DoPipe then
 | |
|          exit;
 | |
|         if not(cs_asm_extern in aktglobalswitches) then
 | |
|          begin
 | |
|            if SmartAsm then
 | |
|             begin
 | |
|               if (SmartFilesCount<=1) then
 | |
|                Message1(exec_i_assembling_smart,name);
 | |
|             end
 | |
|            else
 | |
|            Message1(exec_i_assembling,name);
 | |
|          end;
 | |
|         s:=target_asm.asmcmd;
 | |
| {$ifdef m68k}
 | |
|         if aktoptprocessor = MC68020 then
 | |
|           s:='-m68020 '+s
 | |
|         else
 | |
|           s:='-m68000 '+s;
 | |
| {$endif}
 | |
|         if (cs_link_on_target in aktglobalswitches) then
 | |
|          begin
 | |
|            Replace(s,'$ASM',maybequoted(ScriptFixFileName(AsmFile)));
 | |
|            Replace(s,'$OBJ',maybequoted(ScriptFixFileName(ObjFile)));
 | |
|          end
 | |
|         else
 | |
|          begin
 | |
|            Replace(s,'$ASM',maybequoted(AsmFile));
 | |
|            Replace(s,'$OBJ',maybequoted(ObjFile));
 | |
|          end;
 | |
|         if CallAssembler(FindAssembler,s) then
 | |
|          RemoveAsm
 | |
|         else
 | |
|          begin
 | |
|             DoAssemble:=false;
 | |
|             GenerateError;
 | |
|          end;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     Procedure TExternalAssembler.AsmFlush;
 | |
|       begin
 | |
|         if outcnt>0 then
 | |
|          begin
 | |
|            { suppress i/o error }
 | |
|            {$i-}
 | |
|            BlockWrite(outfile,outbuf,outcnt);
 | |
|            {$i+}
 | |
|            ioerror:=ioerror or (ioresult<>0);
 | |
|            outcnt:=0;
 | |
|          end;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     Procedure TExternalAssembler.AsmClear;
 | |
|       begin
 | |
|         outcnt:=0;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     Procedure TExternalAssembler.AsmWrite(const s:string);
 | |
|       begin
 | |
|         if OutCnt+length(s)>=AsmOutSize then
 | |
|          AsmFlush;
 | |
|         Move(s[1],OutBuf[OutCnt],length(s));
 | |
|         inc(OutCnt,length(s));
 | |
|         inc(AsmSize,length(s));
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     Procedure TExternalAssembler.AsmWriteLn(const s:string);
 | |
|       begin
 | |
|         AsmWrite(s);
 | |
|         AsmLn;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     Procedure TExternalAssembler.AsmWritePChar(p:pchar);
 | |
|       var
 | |
|         i,j : longint;
 | |
|       begin
 | |
|         i:=StrLen(p);
 | |
|         j:=i;
 | |
|         while j>0 do
 | |
|          begin
 | |
|            i:=min(j,AsmOutSize);
 | |
|            if OutCnt+i>=AsmOutSize then
 | |
|             AsmFlush;
 | |
|            Move(p[0],OutBuf[OutCnt],i);
 | |
|            inc(OutCnt,i);
 | |
|            inc(AsmSize,i);
 | |
|            dec(j,i);
 | |
|            p:=pchar(@p[i]);
 | |
|          end;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     Procedure TExternalAssembler.AsmLn;
 | |
|       begin
 | |
|         if OutCnt>=AsmOutSize-2 then
 | |
|          AsmFlush;
 | |
|         if (cs_link_on_target in aktglobalswitches) then
 | |
|           begin
 | |
|             OutBuf[OutCnt]:=target_info.newline[1];
 | |
|             inc(OutCnt);
 | |
|             inc(AsmSize);
 | |
|             if length(target_info.newline)>1 then
 | |
|              begin
 | |
|                OutBuf[OutCnt]:=target_info.newline[2];
 | |
|                inc(OutCnt);
 | |
|                inc(AsmSize);
 | |
|              end;
 | |
|           end
 | |
|         else
 | |
|           begin
 | |
|             OutBuf[OutCnt]:=source_info.newline[1];
 | |
|             inc(OutCnt);
 | |
|             inc(AsmSize);
 | |
|             if length(source_info.newline)>1 then
 | |
|              begin
 | |
|                OutBuf[OutCnt]:=source_info.newline[2];
 | |
|                inc(OutCnt);
 | |
|                inc(AsmSize);
 | |
|              end;
 | |
|           end;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TExternalAssembler.AsmCreate(Aplace:tcutplace);
 | |
|       begin
 | |
|         if SmartAsm then
 | |
|          NextSmartName(Aplace);
 | |
| {$ifdef hasunix}
 | |
|         if DoPipe then
 | |
|          begin
 | |
|            Message1(exec_i_assembling_pipe,asmfile);
 | |
|            POpen(outfile,'as -o '+objfile,'W');
 | |
|          end
 | |
|         else
 | |
| {$endif}
 | |
|          begin
 | |
|            Assign(outfile,asmfile);
 | |
|            {$I-}
 | |
|            Rewrite(outfile,1);
 | |
|            {$I+}
 | |
|            if ioresult<>0 then
 | |
|              begin
 | |
|                ioerror:=true;
 | |
|                Message1(exec_d_cant_create_asmfile,asmfile);
 | |
|              end;
 | |
|          end;
 | |
|         outcnt:=0;
 | |
|         AsmSize:=0;
 | |
|         AsmStartSize:=0;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TExternalAssembler.AsmClose;
 | |
|       var
 | |
|         f : file;
 | |
|         FileAge : longint;
 | |
|       begin
 | |
|         AsmFlush;
 | |
| {$ifdef hasunix}
 | |
|         if DoPipe then
 | |
|           begin
 | |
|             if PClose(outfile) <> 0 then
 | |
|               GenerateError;
 | |
|           end
 | |
|         else
 | |
| {$endif}
 | |
|          begin
 | |
|          {Touch Assembler time to ppu time is there is a ppufilename}
 | |
|            if ppufilename<>'' then
 | |
|             begin
 | |
|               Assign(f,ppufilename);
 | |
|               {$I-}
 | |
|               reset(f,1);
 | |
|               {$I+}
 | |
|               if ioresult=0 then
 | |
|                begin
 | |
| {$IFDEF USE_SYSUTILS}
 | |
|                  FileAge := FileGetDate(GetFileHandle(f));
 | |
| {$ELSE USE_SYSUTILS}
 | |
|                  GetFTime(f, FileAge);
 | |
| {$ENDIF USE_SYSUTILS}
 | |
|                  close(f);
 | |
|                  reset(outfile,1);
 | |
| {$IFDEF USE_SYSUTILS}
 | |
|                  FileSetDate(GetFileHandle(outFile),FileAge);
 | |
| {$ELSE USE_SYSUTILS}
 | |
|                  SetFTime(f, FileAge);
 | |
| {$ENDIF USE_SYSUTILS}
 | |
|                end;
 | |
|             end;
 | |
|            close(outfile);
 | |
|          end;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TExternalAssembler.WriteTree(p:TAAsmoutput);
 | |
|       begin
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TExternalAssembler.WriteAsmList;
 | |
|       begin
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TExternalAssembler.MakeObject;
 | |
|       begin
 | |
|         AsmCreate(cut_normal);
 | |
|         WriteAsmList;
 | |
|         AsmClose;
 | |
|         if not(ioerror) then
 | |
|           DoAssemble;
 | |
|       end;
 | |
| 
 | |
| 
 | |
| {*****************************************************************************
 | |
|                                   TInternalAssembler
 | |
| *****************************************************************************}
 | |
| 
 | |
|     constructor TInternalAssembler.create(smart:boolean);
 | |
|       begin
 | |
|         inherited create(smart);
 | |
|         objectoutput:=nil;
 | |
|         objectdata:=nil;
 | |
|         SmartAsm:=smart;
 | |
|         currpass:=0;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|    destructor TInternalAssembler.destroy;
 | |
| {$ifdef MEMDEBUG}
 | |
|       var
 | |
|         d : tmemdebug;
 | |
| {$endif}
 | |
|       begin
 | |
| {$ifdef MEMDEBUG}
 | |
|         d := tmemdebug.create(name+' - agbin');
 | |
| {$endif}
 | |
|         objectdata.free;
 | |
|         objectoutput.free;
 | |
| {$ifdef MEMDEBUG}
 | |
|         d.free;
 | |
| {$endif}
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TInternalAssembler.convertstab(p:pchar);
 | |
| 
 | |
|         function consumecomma(var p:pchar):boolean;
 | |
|         begin
 | |
|           while (p^=' ') do
 | |
|             inc(p);
 | |
|           result:=(p^=',');
 | |
|           inc(p);
 | |
|         end;
 | |
| 
 | |
|         function consumenumber(var p:pchar;out value:longint):boolean;
 | |
|         var
 | |
|           hs : string;
 | |
|           len,
 | |
|           code : integer;
 | |
|         begin
 | |
|           value:=0;
 | |
|           while (p^=' ') do
 | |
|             inc(p);
 | |
|           len:=0;
 | |
|           while (p^ in ['0'..'9']) do
 | |
|             begin
 | |
|               inc(len);
 | |
|               hs[len]:=p^;
 | |
|               inc(p);
 | |
|             end;
 | |
|           if len>0 then
 | |
|             begin
 | |
|               hs[0]:=chr(len);
 | |
|               val(hs,value,code);
 | |
|             end
 | |
|           else
 | |
|             code:=-1;
 | |
|           result:=(code=0);
 | |
|         end;
 | |
| 
 | |
|         function consumeoffset(var p:pchar;out relocsym:tasmsymbol;out value:longint):boolean;
 | |
|         var
 | |
|           hs        : string;
 | |
|           len,
 | |
|           code      : integer;
 | |
|           pstart    : pchar;
 | |
|           sym       : tasmsymbol;
 | |
|           exprvalue : longint;
 | |
|           gotmin,
 | |
|           dosub     : boolean;
 | |
|         begin
 | |
|           result:=false;
 | |
|           value:=0;
 | |
|           relocsym:=nil;
 | |
|           gotmin:=false;
 | |
|           repeat
 | |
|             dosub:=false;
 | |
|             exprvalue:=0;
 | |
|             if gotmin then
 | |
|               begin
 | |
|                 dosub:=true;
 | |
|                 gotmin:=false;
 | |
|               end;
 | |
|             while (p^=' ') do
 | |
|               inc(p);
 | |
|             case p^ of
 | |
|               #0 :
 | |
|                 break;
 | |
|               ' ' :
 | |
|                 inc(p);
 | |
|               '0'..'9' :
 | |
|                 begin
 | |
|                   len:=0;
 | |
|                   while (p^ in ['0'..'9']) do
 | |
|                     begin
 | |
|                       inc(len);
 | |
|                       hs[len]:=p^;
 | |
|                       inc(p);
 | |
|                     end;
 | |
|                   hs[0]:=chr(len);
 | |
|                   val(hs,exprvalue,code);
 | |
|                 end;
 | |
|               '.','_',
 | |
|               'A'..'Z',
 | |
|               'a'..'z' :
 | |
|                 begin
 | |
|                   pstart:=p;
 | |
|                   while not(p^ in [#0,' ','-','+']) do
 | |
|                     inc(p);
 | |
|                   len:=p-pstart;
 | |
|                   if len>255 then
 | |
|                     internalerror(200509187);
 | |
|                   move(pstart^,hs[1],len);
 | |
|                   hs[0]:=chr(len);
 | |
|                   sym:=objectlibrary.newasmsymbol(hs,AB_EXTERNAL,AT_NONE);
 | |
|                   if not assigned(sym) then
 | |
|                     internalerror(200509188);
 | |
|                   objectlibrary.UsedAsmSymbolListInsert(sym);
 | |
|                   { Second symbol? }
 | |
|                   if assigned(relocsym) then
 | |
|                     begin
 | |
|                       if (relocsym.section<>sym.section) then
 | |
|                         internalerror(2005091810);
 | |
|                       relocsym:=nil;
 | |
|                     end
 | |
|                   else
 | |
|                     begin
 | |
|                       relocsym:=sym;
 | |
|                     end;
 | |
|                   exprvalue:=sym.address;
 | |
|                 end;
 | |
|               '+' :
 | |
|                 begin
 | |
|                   { nothing, by default addition is done }
 | |
|                   inc(p);
 | |
|                 end;
 | |
|               '-' :
 | |
|                 begin
 | |
|                   gotmin:=true;
 | |
|                   inc(p);
 | |
|                 end;
 | |
|               else
 | |
|                 internalerror(200509189);
 | |
|             end;
 | |
|             if dosub then
 | |
|               dec(value,exprvalue)
 | |
|             else
 | |
|               inc(value,exprvalue);
 | |
|           until false;
 | |
|           result:=true;
 | |
|         end;
 | |
| 
 | |
|       const
 | |
|         N_Function = $24; { function or const }
 | |
|       var
 | |
|         ofs,
 | |
|         nline,
 | |
|         nidx,
 | |
|         nother,
 | |
|         i         : longint;
 | |
|         relocsym  : tasmsymbol;
 | |
|         pstr,
 | |
|         pcurr,
 | |
|         pendquote : pchar;
 | |
|       begin
 | |
|         pcurr:=nil;
 | |
|         pstr:=nil;
 | |
|         pendquote:=nil;
 | |
| 
 | |
|         { Parse string part }
 | |
|         if p[0]='"' then
 | |
|           begin
 | |
|             pstr:=@p[1];
 | |
|             { Ignore \" inside the string }
 | |
|             i:=1;
 | |
|             while not((p[i]='"') and (p[i-1]<>'\')) and
 | |
|                   (p[i]<>#0) do
 | |
|               inc(i);
 | |
|             pendquote:=@p[i];
 | |
|             pendquote^:=#0;
 | |
|             pcurr:=@p[i+1];
 | |
|             if not consumecomma(pcurr) then
 | |
|               internalerror(200509181);
 | |
|           end
 | |
|         else
 | |
|           pcurr:=p;
 | |
| 
 | |
|         { When in pass 1 then only alloc and leave }
 | |
|         if currpass=1 then
 | |
|           objectdata.allocstab(pstr)
 | |
|         else
 | |
|           begin
 | |
|             { Stabs format: nidx,nother,nline[,offset] }
 | |
|             if not consumenumber(pcurr,nidx) then
 | |
|               internalerror(200509182);
 | |
|             if not consumecomma(pcurr) then
 | |
|               internalerror(200509183);
 | |
|             if not consumenumber(pcurr,nother) then
 | |
|               internalerror(200509184);
 | |
|             if not consumecomma(pcurr) then
 | |
|               internalerror(200509185);
 | |
|             if not consumenumber(pcurr,nline) then
 | |
|               internalerror(200509186);
 | |
|             if consumecomma(pcurr) then
 | |
|               consumeoffset(pcurr,relocsym,ofs)
 | |
|             else
 | |
|               begin
 | |
|                 ofs:=0;
 | |
|                 relocsym:=nil;
 | |
|               end;
 | |
|             if (nidx=N_Function) and
 | |
|                target_info.use_function_relative_addresses then
 | |
|               ofs:=0;
 | |
|             objectdata.writestab(ofs,relocsym,nidx,nother,nline,pstr);
 | |
|           end;
 | |
|         if assigned(pendquote) then
 | |
|           pendquote^:='"';
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     function TInternalAssembler.MaybeNextList(var hp:Tai):boolean;
 | |
|       begin
 | |
|         { maybe end of list }
 | |
|         while not assigned(hp) do
 | |
|          begin
 | |
|            if currlistidx<lists then
 | |
|             begin
 | |
|               inc(currlistidx);
 | |
|               currlist:=list[currlistidx];
 | |
|               hp:=Tai(currList.first);
 | |
|             end
 | |
|            else
 | |
|             begin
 | |
|               MaybeNextList:=false;
 | |
|               exit;
 | |
|             end;
 | |
|          end;
 | |
|         MaybeNextList:=true;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     function TInternalAssembler.TreePass0(hp:Tai):Tai;
 | |
|       var
 | |
|         l : longint;
 | |
|       begin
 | |
|         while assigned(hp) do
 | |
|          begin
 | |
|            case hp.typ of
 | |
|              ait_align :
 | |
|                begin
 | |
|                  { always use the maximum fillsize in this pass to avoid possible
 | |
|                    short jumps to become out of range }
 | |
|                  Tai_align(hp).fillsize:=Tai_align(hp).aligntype;
 | |
|                  objectdata.alloc(Tai_align(hp).fillsize);
 | |
|                end;
 | |
|              ait_datablock :
 | |
|                begin
 | |
|                  l:=used_align(size_2_align(Tai_datablock(hp).size),0,objectdata.currsec.addralign);
 | |
|                  if SmartAsm or (not Tai_datablock(hp).is_global) then
 | |
|                    begin
 | |
|                      objectdata.allocalign(l);
 | |
|                      objectdata.alloc(Tai_datablock(hp).size);
 | |
|                    end;
 | |
|                end;
 | |
|              ait_real_80bit :
 | |
|                objectdata.alloc(10);
 | |
|              ait_real_64bit :
 | |
|                objectdata.alloc(8);
 | |
|              ait_real_32bit :
 | |
|                objectdata.alloc(4);
 | |
|              ait_comp_64bit :
 | |
|                objectdata.alloc(8);
 | |
|              ait_const_64bit,
 | |
|              ait_const_32bit,
 | |
|              ait_const_16bit,
 | |
|              ait_const_8bit,
 | |
|              ait_const_rva_symbol,
 | |
|              ait_const_indirect_symbol :
 | |
|                objectdata.alloc(tai_const(hp).size);
 | |
|              ait_section:
 | |
|                begin
 | |
|                  objectdata.CreateSection(Tai_section(hp).sectype,Tai_section(hp).name^,Tai_section(hp).secalign,[]);
 | |
|                  Tai_section(hp).sec:=objectdata.CurrSec;
 | |
|                end;
 | |
|              ait_symbol :
 | |
|                objectdata.allocsymbol(currpass,Tai_symbol(hp).sym,0);
 | |
|              ait_label :
 | |
|                objectdata.allocsymbol(currpass,Tai_label(hp).l,0);
 | |
|              ait_string :
 | |
|                objectdata.alloc(Tai_string(hp).len);
 | |
|              ait_instruction :
 | |
|                begin
 | |
| {$ifdef i386}
 | |
| {$ifndef NOAG386BIN}
 | |
|                  { reset instructions which could change in pass 2 }
 | |
|                  Taicpu(hp).resetpass2;
 | |
|                  objectdata.alloc(Taicpu(hp).Pass1(objectdata.currsec.datasize));
 | |
| {$endif NOAG386BIN}
 | |
| {$endif i386}
 | |
| {$ifdef arm}
 | |
|                  { reset instructions which could change in pass 2 }
 | |
|                  Taicpu(hp).resetpass2;
 | |
|                  objectdata.alloc(Taicpu(hp).Pass1(objectdata.currsec.datasize));
 | |
| {$endif arm}
 | |
|                end;
 | |
|              ait_cutobject :
 | |
|                if SmartAsm then
 | |
|                 break;
 | |
|            end;
 | |
|            hp:=Tai(hp.next);
 | |
|          end;
 | |
|         TreePass0:=hp;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     function TInternalAssembler.TreePass1(hp:Tai):Tai;
 | |
|       var
 | |
|         InlineLevel,
 | |
|         l,
 | |
|         i : longint;
 | |
|       begin
 | |
|         inlinelevel:=0;
 | |
|         while assigned(hp) do
 | |
|          begin
 | |
|            case hp.typ of
 | |
|              ait_align :
 | |
|                begin
 | |
|                  { here we must determine the fillsize which is used in pass2 }
 | |
|                  Tai_align(hp).fillsize:=align(objectdata.currsec.datasize,Tai_align(hp).aligntype)-
 | |
|                    objectdata.currsec.datasize;
 | |
|                  objectdata.alloc(Tai_align(hp).fillsize);
 | |
|                end;
 | |
|              ait_datablock :
 | |
|                begin
 | |
|                  if not (objectdata.currsec.sectype in [sec_bss,sec_threadvar]) then
 | |
|                    Message(asmw_e_alloc_data_only_in_bss);
 | |
|                  l:=used_align(size_2_align(Tai_datablock(hp).size),0,objectdata.currsec.addralign);
 | |
| {                 if Tai_datablock(hp).is_global and
 | |
|                     not SmartAsm then
 | |
|                   begin}
 | |
| {                    objectdata.allocsymbol(currpass,Tai_datablock(hp).sym,Tai_datablock(hp).size);}
 | |
|                     { force to be common/external, must be after setaddress as that would
 | |
|                       set it to AB_GLOBAL }
 | |
| {                    Tai_datablock(hp).sym.currbind:=AB_COMMON;
 | |
|                   end
 | |
|                  else
 | |
|                   begin}
 | |
|                     objectdata.allocalign(l);
 | |
|                     objectdata.allocsymbol(currpass,Tai_datablock(hp).sym,Tai_datablock(hp).size);
 | |
|                     objectdata.alloc(Tai_datablock(hp).size);
 | |
| {                  end;}
 | |
|                  objectlibrary.UsedAsmSymbolListInsert(Tai_datablock(hp).sym);
 | |
|                end;
 | |
|              ait_real_80bit :
 | |
|                objectdata.alloc(10);
 | |
|              ait_real_64bit :
 | |
|                objectdata.alloc(8);
 | |
|              ait_real_32bit :
 | |
|                objectdata.alloc(4);
 | |
|              ait_comp_64bit :
 | |
|                objectdata.alloc(8);
 | |
|              ait_const_64bit,
 | |
|              ait_const_32bit,
 | |
|              ait_const_16bit,
 | |
|              ait_const_8bit,
 | |
|              ait_const_rva_symbol,
 | |
|              ait_const_indirect_symbol :
 | |
|                begin
 | |
|                  objectdata.alloc(tai_const(hp).size);
 | |
|                  if assigned(Tai_const(hp).sym) then
 | |
|                    objectlibrary.UsedAsmSymbolListInsert(Tai_const(hp).sym);
 | |
|                  if assigned(Tai_const(hp).endsym) then
 | |
|                    objectlibrary.UsedAsmSymbolListInsert(Tai_const(hp).endsym);
 | |
|                end;
 | |
|              ait_section:
 | |
|                begin
 | |
|                  { use cached value }
 | |
|                  objectdata.setsection(Tai_section(hp).sec);
 | |
|                end;
 | |
|              ait_stab :
 | |
|                begin
 | |
|                  if assigned(Tai_stab(hp).str) then
 | |
|                    convertstab(Tai_stab(hp).str);
 | |
|                end;
 | |
|              ait_function_name,
 | |
|              ait_force_line : ;
 | |
|              ait_symbol :
 | |
|                begin
 | |
|                  objectdata.allocsymbol(currpass,Tai_symbol(hp).sym,0);
 | |
|                  objectlibrary.UsedAsmSymbolListInsert(Tai_symbol(hp).sym);
 | |
|                end;
 | |
|              ait_symbol_end :
 | |
|                begin
 | |
|                  if target_info.system in [system_i386_linux,system_i386_beos] then
 | |
|                   begin
 | |
|                     Tai_symbol_end(hp).sym.size:=objectdata.currsec.datasize-Tai_symbol_end(hp).sym.address;
 | |
|                     objectlibrary.UsedAsmSymbolListInsert(Tai_symbol_end(hp).sym);
 | |
|                   end;
 | |
|                 end;
 | |
|              ait_label :
 | |
|                begin
 | |
|                  objectdata.allocsymbol(currpass,Tai_label(hp).l,0);
 | |
|                  objectlibrary.UsedAsmSymbolListInsert(Tai_label(hp).l);
 | |
|                end;
 | |
|              ait_string :
 | |
|                objectdata.alloc(Tai_string(hp).len);
 | |
|              ait_instruction :
 | |
|                begin
 | |
|                  objectdata.alloc(Taicpu(hp).Pass1(objectdata.currsec.datasize));
 | |
|                  { fixup the references }
 | |
|                  for i:=1 to Taicpu(hp).ops do
 | |
|                   begin
 | |
|                     with Taicpu(hp).oper[i-1]^ do
 | |
|                      begin
 | |
|                        case typ of
 | |
|                          top_ref :
 | |
|                            begin
 | |
|                              if assigned(ref^.symbol) then
 | |
|                               objectlibrary.UsedAsmSymbolListInsert(ref^.symbol);
 | |
|                              if assigned(ref^.relsymbol) then
 | |
|                               objectlibrary.UsedAsmSymbolListInsert(ref^.symbol);
 | |
|                            end;
 | |
|                        end;
 | |
|                      end;
 | |
|                   end;
 | |
|                end;
 | |
|              ait_cutobject :
 | |
|                if SmartAsm then
 | |
|                 break;
 | |
|              ait_marker :
 | |
|                if tai_marker(hp).kind=InlineStart then
 | |
|                  inc(InlineLevel)
 | |
|                else if tai_marker(hp).kind=InlineEnd then
 | |
|                  dec(InlineLevel);
 | |
|            end;
 | |
|            hp:=Tai(hp.next);
 | |
|          end;
 | |
|         TreePass1:=hp;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     function TInternalAssembler.TreePass2(hp:Tai):Tai;
 | |
|       var
 | |
|         fillbuffer : tfillbuffer;
 | |
|         InlineLevel,
 | |
|         l  : longint;
 | |
|         v  : int64;
 | |
| {$ifdef x86}
 | |
|         co : comp;
 | |
| {$endif x86}
 | |
|       begin
 | |
|         inlinelevel:=0;
 | |
|         { main loop }
 | |
|         while assigned(hp) do
 | |
|          begin
 | |
|            case hp.typ of
 | |
|              ait_align :
 | |
|                begin
 | |
|                  if objectdata.currsec.sectype in [sec_bss,sec_threadvar] then
 | |
|                    objectdata.alloc(Tai_align(hp).fillsize)
 | |
|                  else
 | |
|                    objectdata.writebytes(Tai_align(hp).calculatefillbuf(fillbuffer)^,Tai_align(hp).fillsize);
 | |
|                end;
 | |
|              ait_section :
 | |
|                begin
 | |
|                  { use cached value }
 | |
|                  objectdata.setsection(Tai_section(hp).sec);
 | |
|                end;
 | |
|              ait_symbol :
 | |
|                begin
 | |
|                  objectdata.writesymbol(Tai_symbol(hp).sym);
 | |
|                  objectoutput.exportsymbol(Tai_symbol(hp).sym);
 | |
|                end;
 | |
|              ait_datablock :
 | |
|                begin
 | |
|                  l:=used_align(size_2_align(Tai_datablock(hp).size),0,objectdata.currsec.addralign);
 | |
|                  objectdata.writesymbol(Tai_datablock(hp).sym);
 | |
|                  objectoutput.exportsymbol(Tai_datablock(hp).sym);
 | |
| {                 if SmartAsm or (not Tai_datablock(hp).is_global) then
 | |
|                    begin}
 | |
|                      objectdata.allocalign(l);
 | |
|                      objectdata.alloc(Tai_datablock(hp).size);
 | |
| {                   end;}
 | |
|                end;
 | |
|              ait_real_80bit :
 | |
|                objectdata.writebytes(Tai_real_80bit(hp).value,10);
 | |
|              ait_real_64bit :
 | |
|                objectdata.writebytes(Tai_real_64bit(hp).value,8);
 | |
|              ait_real_32bit :
 | |
|                objectdata.writebytes(Tai_real_32bit(hp).value,4);
 | |
|              ait_comp_64bit :
 | |
|                begin
 | |
| {$ifdef x86}
 | |
|                  co:=comp(Tai_comp_64bit(hp).value);
 | |
|                  objectdata.writebytes(co,8);
 | |
| {$endif x86}
 | |
|                end;
 | |
|              ait_string :
 | |
|                objectdata.writebytes(Tai_string(hp).str^,Tai_string(hp).len);
 | |
|              ait_const_64bit,
 | |
|              ait_const_32bit,
 | |
|              ait_const_16bit,
 | |
|              ait_const_8bit :
 | |
|                begin
 | |
|                  if assigned(tai_const(hp).sym) then
 | |
|                    begin
 | |
|                      if assigned(tai_const(hp).endsym) then
 | |
|                        begin
 | |
|                          if tai_const(hp).endsym.section<>tai_const(hp).sym.section then
 | |
|                            internalerror(200404124);
 | |
|                          v:=tai_const(hp).endsym.address-tai_const(hp).sym.address+Tai_const(hp).value;
 | |
|                          objectdata.writebytes(v,tai_const(hp).size);
 | |
|                        end
 | |
|                      else
 | |
|                        objectdata.writereloc(Tai_const(hp).value,Tai_const(hp).size,
 | |
|                                              Tai_const(hp).sym,RELOC_ABSOLUTE);
 | |
|                    end
 | |
|                  else
 | |
|                    objectdata.writebytes(Tai_const(hp).value,tai_const(hp).size);
 | |
|                end;
 | |
|              ait_const_rva_symbol :
 | |
|                objectdata.writereloc(Tai_const(hp).value,sizeof(aint),Tai_const(hp).sym,RELOC_RVA);
 | |
|              ait_label :
 | |
|                begin
 | |
|                  objectdata.writesymbol(Tai_label(hp).l);
 | |
|                  { exporting shouldn't be necessary as labels are local,
 | |
|                    but it's better to be on the safe side (PFV) }
 | |
|                  objectoutput.exportsymbol(Tai_label(hp).l);
 | |
|                end;
 | |
|              ait_instruction :
 | |
|                Taicpu(hp).Pass2(objectdata);
 | |
|              ait_stab :
 | |
|                convertstab(Tai_stab(hp).str);
 | |
|              ait_function_name,
 | |
|              ait_force_line : ;
 | |
|              ait_cutobject :
 | |
|                if SmartAsm then
 | |
|                 break;
 | |
|              ait_marker :
 | |
|                if tai_marker(hp).kind=InlineStart then
 | |
|                  inc(InlineLevel)
 | |
|                else if tai_marker(hp).kind=InlineEnd then
 | |
|                  dec(InlineLevel);
 | |
|            end;
 | |
|            hp:=Tai(hp.next);
 | |
|          end;
 | |
|         TreePass2:=hp;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TInternalAssembler.writetree;
 | |
|       var
 | |
|         hp : Tai;
 | |
|       label
 | |
|         doexit;
 | |
|       begin
 | |
|         objectdata:=objectoutput.newobjectdata(Objfile);
 | |
|         { reset the asmsymbol list }
 | |
|         objectlibrary.CreateUsedAsmsymbolList;
 | |
| 
 | |
|       { Pass 0 }
 | |
|         currpass:=0;
 | |
|         objectdata.createsection(sec_code,'',0,[]);
 | |
|         objectdata.beforealloc;
 | |
|         { start with list 1 }
 | |
|         currlistidx:=1;
 | |
|         currlist:=list[currlistidx];
 | |
|         hp:=Tai(currList.first);
 | |
|         while assigned(hp) do
 | |
|          begin
 | |
|            hp:=TreePass0(hp);
 | |
|            MaybeNextList(hp);
 | |
|          end;
 | |
|         objectdata.afteralloc;
 | |
|         { leave if errors have occured }
 | |
|         if errorcount>0 then
 | |
|          goto doexit;
 | |
| 
 | |
|       { Pass 1 }
 | |
|         currpass:=1;
 | |
|         objectdata.resetsections;
 | |
|         objectdata.beforealloc;
 | |
|         objectdata.createsection(sec_code,'',0,[]);
 | |
|         { start with list 1 }
 | |
|         currlistidx:=1;
 | |
|         currlist:=list[currlistidx];
 | |
|         hp:=Tai(currList.first);
 | |
|         while assigned(hp) do
 | |
|          begin
 | |
|            hp:=TreePass1(hp);
 | |
|            MaybeNextList(hp);
 | |
|          end;
 | |
|         objectdata.createsection(sec_code,'',0,[]);
 | |
|         objectdata.afteralloc;
 | |
|         { check for undefined labels and reset }
 | |
|         objectlibrary.UsedAsmSymbolListCheckUndefined;
 | |
| 
 | |
|         { leave if errors have occured }
 | |
|         if errorcount>0 then
 | |
|          goto doexit;
 | |
| 
 | |
|       { Pass 2 }
 | |
|         currpass:=2;
 | |
|         objectdata.resetsections;
 | |
|         objectdata.beforewrite;
 | |
|         objectdata.createsection(sec_code,'',0,[]);
 | |
|         { start with list 1 }
 | |
|         currlistidx:=1;
 | |
|         currlist:=list[currlistidx];
 | |
|         hp:=Tai(currList.first);
 | |
|         while assigned(hp) do
 | |
|          begin
 | |
|            hp:=TreePass2(hp);
 | |
|            MaybeNextList(hp);
 | |
|          end;
 | |
|         objectdata.createsection(sec_code,'',0,[]);
 | |
|         objectdata.afterwrite;
 | |
| 
 | |
|         { don't write the .o file if errors have occured }
 | |
|         if errorcount=0 then
 | |
|          begin
 | |
|            { write objectfile }
 | |
|            objectoutput.startobjectfile(ObjFile);
 | |
|            objectoutput.writeobjectfile(objectdata);
 | |
|            objectdata.free;
 | |
|            objectdata:=nil;
 | |
|          end;
 | |
| 
 | |
|       doexit:
 | |
|         { reset the used symbols back, must be after the .o has been
 | |
|           written }
 | |
|         objectlibrary.UsedAsmsymbolListReset;
 | |
|         objectlibrary.DestroyUsedAsmsymbolList;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TInternalAssembler.writetreesmart;
 | |
|       var
 | |
|         hp : Tai;
 | |
|         startsectype : TAsmSectionType;
 | |
|         place: tcutplace;
 | |
|       begin
 | |
|         NextSmartName(cut_normal);
 | |
|         objectdata:=objectoutput.newobjectdata(Objfile);
 | |
|         startsectype:=sec_code;
 | |
| 
 | |
|         { start with list 1 }
 | |
|         currlistidx:=1;
 | |
|         currlist:=list[currlistidx];
 | |
|         hp:=Tai(currList.first);
 | |
|         while assigned(hp) do
 | |
|          begin
 | |
|          { reset the asmsymbol list }
 | |
|            objectlibrary.CreateUsedAsmSymbolList;
 | |
| 
 | |
|          { Pass 0 }
 | |
|            currpass:=0;
 | |
|            objectdata.resetsections;
 | |
|            objectdata.beforealloc;
 | |
|            objectdata.createsection(startsectype,'',0,[]);
 | |
|            TreePass0(hp);
 | |
|            objectdata.afteralloc;
 | |
|            { leave if errors have occured }
 | |
|            if errorcount>0 then
 | |
|             exit;
 | |
| 
 | |
|          { Pass 1 }
 | |
|            currpass:=1;
 | |
|            objectdata.resetsections;
 | |
|            objectdata.beforealloc;
 | |
|            objectdata.createsection(startsectype,'',0,[]);
 | |
|            TreePass1(hp);
 | |
|            objectdata.afteralloc;
 | |
|            { check for undefined labels }
 | |
|            objectlibrary.UsedAsmSymbolListCheckUndefined;
 | |
| 
 | |
|            { leave if errors have occured }
 | |
|            if errorcount>0 then
 | |
|             exit;
 | |
| 
 | |
|          { Pass 2 }
 | |
|            currpass:=2;
 | |
|            objectoutput.startobjectfile(Objfile);
 | |
|            objectdata.resetsections;
 | |
|            objectdata.beforewrite;
 | |
|            objectdata.createsection(startsectype,'',0,[]);
 | |
|            hp:=TreePass2(hp);
 | |
|            { save section type for next loop, must be done before EndFileLineInfo
 | |
|              because that changes the section to sec_code }
 | |
|            startsectype:=objectdata.currsec.sectype;
 | |
|            objectdata.afterwrite;
 | |
|            { leave if errors have occured }
 | |
|            if errorcount>0 then
 | |
|             exit;
 | |
| 
 | |
|            { write the current objectfile }
 | |
|            objectoutput.writeobjectfile(objectdata);
 | |
|            objectdata.free;
 | |
|            objectdata:=nil;
 | |
| 
 | |
|            { reset the used symbols back, must be after the .o has been
 | |
|              written }
 | |
|            objectlibrary.UsedAsmsymbolListReset;
 | |
|            objectlibrary.DestroyUsedAsmsymbolList;
 | |
| 
 | |
|            { end of lists? }
 | |
|            if not MaybeNextList(hp) then
 | |
|             break;
 | |
| 
 | |
|            { we will start a new objectfile so reset everything }
 | |
|            { The place can still change in the next while loop, so don't init }
 | |
|            { the writer yet (JM)                                              }
 | |
|            if (hp.typ=ait_cutobject) then
 | |
|             place := Tai_cutobject(hp).place
 | |
|            else
 | |
|             place := cut_normal;
 | |
| 
 | |
|            { avoid empty files }
 | |
|            while assigned(hp) and
 | |
|                  (Tai(hp).typ in [ait_marker,ait_comment,ait_section,ait_cutobject]) do
 | |
|             begin
 | |
|               if Tai(hp).typ=ait_section then
 | |
|                startsectype:=Tai_section(hp).sectype
 | |
|               else if (Tai(hp).typ=ait_cutobject) then
 | |
|                place:=Tai_cutobject(hp).place;
 | |
|               hp:=Tai(hp.next);
 | |
|             end;
 | |
|            { there is a problem if startsectype is sec_none !! PM }
 | |
|            if startsectype=sec_none then
 | |
|              startsectype:=sec_code;
 | |
| 
 | |
|            if not MaybeNextList(hp) then
 | |
|              break;
 | |
| 
 | |
|            { start next objectfile }
 | |
|            NextSmartName(place);
 | |
|            objectdata:=objectoutput.newobjectdata(Objfile);
 | |
|          end;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure TInternalAssembler.MakeObject;
 | |
| 
 | |
|     var to_do:set of Tasmlist;
 | |
|         i:Tasmlist;
 | |
| 
 | |
|         procedure addlist(p:TAAsmoutput);
 | |
|         begin
 | |
|           inc(lists);
 | |
|           list[lists]:=p;
 | |
|         end;
 | |
| 
 | |
|       begin
 | |
|         to_do:=[low(Tasmlist)..high(Tasmlist)];
 | |
|         if usedeffileforexports then
 | |
|           exclude(to_do,al_exports);
 | |
|         {$warning TODO internal writer support for dwarf}
 | |
|         exclude(to_do,al_dwarf);
 | |
|         if not(tf_section_threadvars in target_info.flags) then
 | |
|           exclude(to_do,al_threadvars);
 | |
|         for i:=low(Tasmlist) to high(Tasmlist) do
 | |
|           if (i in to_do) and (asmlist[i]<>nil) then
 | |
|             addlist(asmlist[i]);
 | |
| 
 | |
|         if SmartAsm then
 | |
|           writetreesmart
 | |
|         else
 | |
|           writetree;
 | |
|       end;
 | |
| 
 | |
| 
 | |
| {*****************************************************************************
 | |
|                      Generate Assembler Files Main Procedure
 | |
| *****************************************************************************}
 | |
| 
 | |
|     Procedure GenerateAsm(smart:boolean);
 | |
|       var
 | |
|         a : TAssembler;
 | |
|       begin
 | |
|         if not assigned(CAssembler[target_asm.id]) then
 | |
|           Message(asmw_f_assembler_output_not_supported);
 | |
|         a:=CAssembler[target_asm.id].Create(smart);
 | |
|         a.MakeObject;
 | |
|         a.Free;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     Procedure OnlyAsm;
 | |
|       var
 | |
|         a : TExternalAssembler;
 | |
|       begin
 | |
|         a:=TExternalAssembler.Create(false);
 | |
|         a.DoAssemble;
 | |
|         a.Free;
 | |
|       end;
 | |
| 
 | |
| 
 | |
| {*****************************************************************************
 | |
|                                  Init/Done
 | |
| *****************************************************************************}
 | |
| 
 | |
|     procedure RegisterAssembler(const r:tasminfo;c:TAssemblerClass);
 | |
|       var
 | |
|         t : tasm;
 | |
|       begin
 | |
|         t:=r.id;
 | |
|         if assigned(asminfos[t]) then
 | |
|           writeln('Warning: Assembler is already registered!')
 | |
|         else
 | |
|           Getmem(asminfos[t],sizeof(tasminfo));
 | |
|         asminfos[t]^:=r;
 | |
|         CAssembler[t]:=c;
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure InitAssembler;
 | |
|       begin
 | |
|       end;
 | |
| 
 | |
| 
 | |
|     procedure DoneAssembler;
 | |
|       begin
 | |
|       end;
 | |
| 
 | |
| end.
 | 
