mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-10-31 15:31:29 +01:00 
			
		
		
		
	m68k: on the Sinclair QL insert the main program's name into the object, so the RTL later can set it as default job name
git-svn-id: trunk@49189 -
This commit is contained in:
		
							parent
							
								
									5d81c6c43b
								
							
						
					
					
						commit
						b5216a1990
					
				
							
								
								
									
										1
									
								
								.gitattributes
									
									
									
									
										vendored
									
									
								
							
							
						
						
									
										1
									
								
								.gitattributes
									
									
									
									
										vendored
									
									
								
							| @ -409,6 +409,7 @@ compiler/m68k/n68kinl.pas svneol=native#text/plain | |||||||
| compiler/m68k/n68kmat.pas svneol=native#text/plain | compiler/m68k/n68kmat.pas svneol=native#text/plain | ||||||
| compiler/m68k/n68kmem.pas svneol=native#text/plain | compiler/m68k/n68kmem.pas svneol=native#text/plain | ||||||
| compiler/m68k/n68kset.pas svneol=native#text/plain | compiler/m68k/n68kset.pas svneol=native#text/plain | ||||||
|  | compiler/m68k/n68kutil.pas svneol=native#text/plain | ||||||
| compiler/m68k/r68kbss.inc svneol=native#text/plain | compiler/m68k/r68kbss.inc svneol=native#text/plain | ||||||
| compiler/m68k/r68kcon.inc svneol=native#text/plain | compiler/m68k/r68kcon.inc svneol=native#text/plain | ||||||
| compiler/m68k/r68kgas.inc svneol=native#text/plain | compiler/m68k/r68kgas.inc svneol=native#text/plain | ||||||
|  | |||||||
| @ -43,7 +43,8 @@ unit cpunode; | |||||||
|        n68kset, |        n68kset, | ||||||
|        n68kinl, |        n68kinl, | ||||||
|        n68kmat, |        n68kmat, | ||||||
|        n68kcnv |        n68kcnv, | ||||||
|  |        n68kutil | ||||||
|        ; |        ; | ||||||
| 
 | 
 | ||||||
| end. | end. | ||||||
|  | |||||||
							
								
								
									
										74
									
								
								compiler/m68k/n68kutil.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										74
									
								
								compiler/m68k/n68kutil.pas
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,74 @@ | |||||||
|  | { | ||||||
|  |     Copyright (c) 2021 by Karoly Balogh | ||||||
|  | 
 | ||||||
|  |     m68k version of some node tree helper routines | ||||||
|  | 
 | ||||||
|  |     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 n68kutil; | ||||||
|  | 
 | ||||||
|  | {$i fpcdefs.inc} | ||||||
|  | 
 | ||||||
|  | interface | ||||||
|  | 
 | ||||||
|  |     uses | ||||||
|  |       cclasses,ngenutil; | ||||||
|  | 
 | ||||||
|  |     type | ||||||
|  |       t68knodeutils = class(tnodeutils) | ||||||
|  |         class procedure InsertObjectInfo; override; | ||||||
|  |       end; | ||||||
|  | 
 | ||||||
|  | implementation | ||||||
|  | 
 | ||||||
|  |     uses | ||||||
|  |       verbose, | ||||||
|  |       systems, | ||||||
|  |       globals, | ||||||
|  |       fmodule, | ||||||
|  |       aasmbase,aasmdata,aasmtai,aasmcpu,aasmcnst, | ||||||
|  |       symdef,symtype; | ||||||
|  | 
 | ||||||
|  | 
 | ||||||
|  |     class procedure t68knodeutils.InsertObjectInfo; | ||||||
|  |       var | ||||||
|  |         tcb: ttai_typedconstbuilder; | ||||||
|  |         s: shortstring; | ||||||
|  |         sym: tasmsymbol; | ||||||
|  |         def: tdef; | ||||||
|  |       begin | ||||||
|  |         inherited InsertObjectInfo; | ||||||
|  |         if (not current_module.is_unit) and (target_info.system in [system_m68k_sinclairql]) then  | ||||||
|  |           begin | ||||||
|  |             { insert the main program name into the object. this will be set as default job name by the system unit } | ||||||
|  |             tcb:=ctai_typedconstbuilder.create([tcalo_new_section]); | ||||||
|  |             s:=char(length(current_module.realmodulename^))+current_module.realmodulename^+#0; | ||||||
|  |             def:=carraydef.getreusable(cansichartype,length(s)); | ||||||
|  |             tcb.maybe_begin_aggregate(def); | ||||||
|  |             tcb.emit_tai(Tai_string.Create(s),def); | ||||||
|  |             tcb.maybe_end_aggregate(def); | ||||||
|  |             sym:=current_asmdata.DefineAsmSymbol('__fpc_program_name',AB_GLOBAL,AT_DATA,def); | ||||||
|  |             current_asmdata.asmlists[al_globals].concatlist( | ||||||
|  |               tcb.get_final_asmlist(sym,def,sec_rodata,'__fpc_program_name',const_align(current_settings.alignment.constalignmax)) | ||||||
|  |             ); | ||||||
|  |             tcb.free; | ||||||
|  |           end; | ||||||
|  |       end; | ||||||
|  | 
 | ||||||
|  | begin | ||||||
|  |   cnodeutils:=t68knodeutils; | ||||||
|  | end. | ||||||
		Loading…
	
		Reference in New Issue
	
	Block a user
	 Károly Balogh
						Károly Balogh