assemble.pas 88 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566
  1. {
  2. Copyright (c) 1998-2004 by Peter Vreman
  3. This unit handles the assemblerfile write and assembler calls of FPC
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. {# @abstract(This unit handles the assembler file write and assembler calls of FPC)
  18. Handles the calls to the actual external assemblers, as well as the generation
  19. of object files for smart linking. Also contains the base class for writing
  20. the assembler statements to file.
  21. }
  22. unit assemble;
  23. {$i fpcdefs.inc}
  24. interface
  25. uses
  26. SysUtils,
  27. systems,globtype,globals,aasmbase,aasmtai,aasmdata,ogbase,owbase,finput;
  28. const
  29. { maximum of aasmoutput lists there will be }
  30. maxoutputlists = ord(high(tasmlisttype))+1;
  31. { buffer size for writing the .s file }
  32. AsmOutSize=32768*4;
  33. type
  34. TAssembler=class(TObject)
  35. public
  36. {assembler info}
  37. asminfo : pasminfo;
  38. {filenames}
  39. path : TPathStr;
  40. name : string;
  41. AsmFileName, { current .s and .o file }
  42. ObjFileName,
  43. ppufilename : TPathStr;
  44. asmprefix : string;
  45. SmartAsm : boolean;
  46. SmartFilesCount,
  47. SmartHeaderCount : longint;
  48. Constructor Create(info: pasminfo; smart:boolean);virtual;
  49. Destructor Destroy;override;
  50. procedure NextSmartName(place:tcutplace);
  51. procedure MakeObject;virtual;abstract;
  52. end;
  53. TExternalAssembler = class;
  54. IExternalAssemblerOutputFileDecorator=interface
  55. function LinePrefix: AnsiString;
  56. function LinePostfix: AnsiString;
  57. function LineFilter(const s: AnsiString): AnsiString;
  58. function LineEnding(const deflineending: ShortString): ShortString;
  59. end;
  60. TExternalAssemblerOutputFile=class
  61. private
  62. fdecorator: IExternalAssemblerOutputFileDecorator;
  63. protected
  64. owner: TExternalAssembler;
  65. {outfile}
  66. AsmSize,
  67. AsmStartSize,
  68. outcnt : longint;
  69. outbuf : array[0..AsmOutSize-1] of char;
  70. outfile : file;
  71. fioerror : boolean;
  72. linestart: boolean;
  73. Procedure AsmClear;
  74. Procedure MaybeAddLinePrefix;
  75. Procedure MaybeAddLinePostfix;
  76. Procedure AsmWriteAnsiStringUnfiltered(const s: ansistring);
  77. public
  78. Constructor Create(_owner: TExternalAssembler);
  79. Procedure RemoveAsm;virtual;
  80. Procedure AsmFlush;
  81. { mark the current output as the "empty" state (i.e., it only contains
  82. headers/directives etc }
  83. Procedure MarkEmpty;
  84. { clears the assembler output if nothing was added since it was marked
  85. as empty, and returns whether it was empty }
  86. function ClearIfEmpty: boolean;
  87. { these routines will write the filtered version of their argument
  88. according to the current decorator }
  89. procedure AsmWriteFiltered(const c:char);
  90. procedure AsmWriteFiltered(const s:string);
  91. procedure AsmWriteFiltered(const s:ansistring);
  92. procedure AsmWriteFiltered(p:pchar; len: longint);
  93. {# Write a string to the assembler file }
  94. Procedure AsmWrite(const c:char);
  95. Procedure AsmWrite(const s:string);
  96. Procedure AsmWrite(const s:ansistring);
  97. {# Write a string to the assembler file }
  98. Procedure AsmWritePChar(p:pchar);
  99. {# Write a string to the assembler file followed by a new line }
  100. Procedure AsmWriteLn(const c:char);
  101. Procedure AsmWriteLn(const s:string);
  102. Procedure AsmWriteLn(const s:ansistring);
  103. {# Write a new line to the assembler file }
  104. Procedure AsmLn; virtual;
  105. procedure AsmCreate(Aplace:tcutplace);
  106. procedure AsmClose;
  107. property ioerror: boolean read fioerror;
  108. property decorator: IExternalAssemblerOutputFileDecorator read fdecorator write fdecorator;
  109. end;
  110. {# This is the base class which should be overridden for each each
  111. assembler writer. It is used to actually assembler a file,
  112. and write the output to the assembler file.
  113. }
  114. TExternalAssembler=class(TAssembler)
  115. private
  116. { output writer }
  117. fwriter: TExternalAssemblerOutputFile;
  118. ffreewriter: boolean;
  119. procedure CreateSmartLinkPath(const s:TPathStr);
  120. protected
  121. {input source info}
  122. lastfileinfo : tfileposinfo;
  123. infile,
  124. lastinfile : tinputfile;
  125. {last section type written}
  126. lastsectype : TAsmSectionType;
  127. procedure WriteSourceLine(hp: tailineinfo);
  128. procedure WriteTempalloc(hp: tai_tempalloc);
  129. procedure WriteRealConstAsBytes(hp: tai_realconst; const dbdir: string; do_line: boolean);
  130. function single2str(d : single) : string; virtual;
  131. function double2str(d : double) : string; virtual;
  132. function extended2str(e : extended) : string; virtual;
  133. Function DoPipe:boolean; virtual;
  134. function CreateNewAsmWriter: TExternalAssemblerOutputFile; virtual;
  135. {# Return true if the external assembler should run again }
  136. function RerunAssembler: boolean; virtual;
  137. public
  138. {# Returns the complete path and executable name of the assembler
  139. program.
  140. It first tries looking in the UTIL directory if specified,
  141. otherwise it searches in the free pascal binary directory, in
  142. the current working directory and then in the directories
  143. in the $PATH environment.}
  144. Function FindAssembler:string;
  145. {# Actually does the call to the assembler file. Returns false
  146. if the assembling of the file failed.}
  147. Function CallAssembler(const command:string; const para:TCmdStr):Boolean;
  148. Function DoAssemble:boolean;virtual;
  149. {# This routine should be overridden for each assembler, it is used
  150. to actually write the abstract assembler stream to file.}
  151. procedure WriteTree(p:TAsmList);virtual;
  152. {# This routine should be overridden for each assembler, it is used
  153. to actually write all the different abstract assembler streams
  154. by calling for each stream type, the @var(WriteTree) method.}
  155. procedure WriteAsmList;virtual;
  156. {# Constructs the command line for calling the assembler }
  157. function MakeCmdLine: TCmdStr; virtual;
  158. public
  159. Constructor Create(info: pasminfo; smart: boolean); override; final;
  160. Constructor CreateWithWriter(info: pasminfo; wr: TExternalAssemblerOutputFile; freewriter, smart: boolean); virtual;
  161. procedure MakeObject;override;
  162. destructor Destroy; override;
  163. property writer: TExternalAssemblerOutputFile read fwriter;
  164. end;
  165. TExternalAssemblerClass = class of TExternalAssembler;
  166. { TInternalAssembler }
  167. TInternalAssembler=class(TAssembler)
  168. private
  169. FCObjOutput : TObjOutputclass;
  170. FCInternalAr : TObjectWriterClass;
  171. { the aasmoutput lists that need to be processed }
  172. lists : byte;
  173. list : array[1..maxoutputlists] of TAsmList;
  174. { current processing }
  175. currlistidx : byte;
  176. currlist : TAsmList;
  177. procedure WriteStab(p:pchar);
  178. function MaybeNextList(var hp:Tai):boolean;
  179. function SetIndirectToSymbol(hp: Tai; const indirectname: string): Boolean;
  180. function TreePass0(hp:Tai):Tai;
  181. function TreePass1(hp:Tai):Tai;
  182. function TreePass2(hp:Tai):Tai;
  183. procedure writetree;
  184. procedure writetreesmart;
  185. protected
  186. ObjData : TObjData;
  187. ObjOutput : tObjOutput;
  188. property CObjOutput:TObjOutputclass read FCObjOutput write FCObjOutput;
  189. property CInternalAr : TObjectWriterClass read FCInternalAr write FCInternalAr;
  190. public
  191. constructor Create(info: pasminfo; smart: boolean);override;
  192. destructor destroy;override;
  193. procedure MakeObject;override;
  194. end;
  195. TAssemblerClass = class of TAssembler;
  196. Procedure GenerateAsm(smart:boolean);
  197. { get an instance of an external GNU-style assembler that is compatible
  198. with the current target, reusing an existing writer. Used by the LLVM
  199. target to write inline assembler }
  200. function GetExternalGnuAssemblerWithAsmInfoWriter(info: pasminfo; wr: TExternalAssemblerOutputFile): TExternalAssembler;
  201. procedure RegisterAssembler(const r:tasminfo;c:TAssemblerClass);
  202. Implementation
  203. uses
  204. {$ifdef hasunix}
  205. unix,
  206. {$endif}
  207. cutils,cfileutl,
  208. {$ifdef memdebug}
  209. cclasses,
  210. {$endif memdebug}
  211. {$ifdef OMFOBJSUPPORT}
  212. omfbase,
  213. ogomf,
  214. {$endif OMFOBJSUPPORT}
  215. {$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)}
  216. {$else}
  217. {$ifdef FPC_SOFT_FPUX80}
  218. sfpux80,
  219. {$endif FPC_SOFT_FPUX80}
  220. {$endif}
  221. cscript,fmodule,verbose,
  222. cpuinfo,
  223. aasmcpu;
  224. var
  225. CAssembler : array[tasm] of TAssemblerClass;
  226. function fixline(s:string):string;
  227. {
  228. return s with all leading and ending spaces and tabs removed
  229. }
  230. var
  231. i,j,k : integer;
  232. begin
  233. i:=length(s);
  234. while (i>0) and (s[i] in [#9,' ']) do
  235. dec(i);
  236. j:=1;
  237. while (j<i) and (s[j] in [#9,' ']) do
  238. inc(j);
  239. for k:=j to i do
  240. if s[k] in [#0..#31,#127..#255] then
  241. s[k]:='.';
  242. fixline:=Copy(s,j,i-j+1);
  243. end;
  244. {*****************************************************************************
  245. TAssembler
  246. *****************************************************************************}
  247. Constructor TAssembler.Create(info: pasminfo; smart: boolean);
  248. begin
  249. asminfo:=info;
  250. { load start values }
  251. AsmFileName:=current_module.AsmFilename;
  252. ObjFileName:=current_module.ObjFileName;
  253. name:=Lower(current_module.modulename^);
  254. path:=current_module.outputpath;
  255. asmprefix := current_module.asmprefix^;
  256. if current_module.outputpath = '' then
  257. ppufilename := ''
  258. else
  259. ppufilename := current_module.ppufilename;
  260. SmartAsm:=smart;
  261. SmartFilesCount:=0;
  262. SmartHeaderCount:=0;
  263. SmartLinkOFiles.Clear;
  264. end;
  265. Destructor TAssembler.Destroy;
  266. begin
  267. end;
  268. procedure TAssembler.NextSmartName(place:tcutplace);
  269. var
  270. s : string;
  271. begin
  272. inc(SmartFilesCount);
  273. if SmartFilesCount>999999 then
  274. Message(asmw_f_too_many_asm_files);
  275. case place of
  276. cut_begin :
  277. begin
  278. inc(SmartHeaderCount);
  279. s:=asmprefix+tostr(SmartHeaderCount)+'h';
  280. end;
  281. cut_normal :
  282. s:=asmprefix+tostr(SmartHeaderCount)+'s';
  283. cut_end :
  284. s:=asmprefix+tostr(SmartHeaderCount)+'t';
  285. end;
  286. AsmFileName:=Path+FixFileName(s+tostr(SmartFilesCount)+target_info.asmext);
  287. ObjFileName:=Path+FixFileName(s+tostr(SmartFilesCount)+target_info.objext);
  288. { insert in container so it can be cleared after the linking }
  289. SmartLinkOFiles.Insert(ObjFileName);
  290. end;
  291. {*****************************************************************************
  292. TAssemblerOutputFile
  293. *****************************************************************************}
  294. procedure TExternalAssemblerOutputFile.RemoveAsm;
  295. var
  296. g : file;
  297. begin
  298. if cs_asm_leave in current_settings.globalswitches then
  299. exit;
  300. if cs_asm_extern in current_settings.globalswitches then
  301. AsmRes.AddDeleteCommand(owner.AsmFileName)
  302. else
  303. begin
  304. assign(g,owner.AsmFileName);
  305. {$push} {$I-}
  306. erase(g);
  307. {$pop}
  308. if ioresult<>0 then;
  309. end;
  310. end;
  311. Procedure TExternalAssemblerOutputFile.AsmFlush;
  312. begin
  313. if outcnt>0 then
  314. begin
  315. { suppress i/o error }
  316. {$push} {$I-}
  317. BlockWrite(outfile,outbuf,outcnt);
  318. {$pop}
  319. fioerror:=fioerror or (ioresult<>0);
  320. outcnt:=0;
  321. end;
  322. end;
  323. procedure TExternalAssemblerOutputFile.MarkEmpty;
  324. begin
  325. AsmStartSize:=AsmSize
  326. end;
  327. function TExternalAssemblerOutputFile.ClearIfEmpty: boolean;
  328. begin
  329. result:=AsmSize=AsmStartSize;
  330. if result then
  331. AsmClear;
  332. end;
  333. procedure TExternalAssemblerOutputFile.AsmWriteFiltered(const c: char);
  334. begin
  335. MaybeAddLinePrefix;
  336. AsmWriteAnsiStringUnfiltered(decorator.LineFilter(c));
  337. end;
  338. procedure TExternalAssemblerOutputFile.AsmWriteFiltered(const s: string);
  339. begin
  340. MaybeAddLinePrefix;
  341. AsmWriteAnsiStringUnfiltered(decorator.LineFilter(s));
  342. end;
  343. procedure TExternalAssemblerOutputFile.AsmWriteFiltered(const s: ansistring);
  344. begin
  345. MaybeAddLinePrefix;
  346. AsmWriteAnsiStringUnfiltered(decorator.LineFilter(s));
  347. end;
  348. procedure TExternalAssemblerOutputFile.AsmWriteFiltered(p: pchar; len: longint);
  349. var
  350. s: ansistring;
  351. begin
  352. MaybeAddLinePrefix;
  353. s:='';
  354. setlength(s,len);
  355. move(p^,s[1],len);
  356. AsmWriteAnsiStringUnfiltered(decorator.LineFilter(s));
  357. end;
  358. Procedure TExternalAssemblerOutputFile.AsmClear;
  359. begin
  360. outcnt:=0;
  361. end;
  362. procedure TExternalAssemblerOutputFile.MaybeAddLinePrefix;
  363. begin
  364. if assigned(decorator) and
  365. linestart then
  366. begin
  367. AsmWriteAnsiStringUnfiltered(decorator.LinePrefix);
  368. linestart:=false;
  369. end;
  370. end;
  371. procedure TExternalAssemblerOutputFile.MaybeAddLinePostfix;
  372. begin
  373. if assigned(decorator) and
  374. not linestart then
  375. begin
  376. AsmWriteAnsiStringUnfiltered(decorator.LinePostfix);
  377. linestart:=true;
  378. end;
  379. end;
  380. procedure TExternalAssemblerOutputFile.AsmWriteAnsiStringUnfiltered(const s: ansistring);
  381. var
  382. StartIndex, ToWrite: longint;
  383. begin
  384. if s='' then
  385. exit;
  386. if OutCnt+length(s)>=AsmOutSize then
  387. AsmFlush;
  388. StartIndex:=1;
  389. ToWrite:=length(s);
  390. while ToWrite>AsmOutSize do
  391. begin
  392. Move(s[StartIndex],OutBuf[OutCnt],AsmOutSize);
  393. inc(OutCnt,AsmOutSize);
  394. inc(AsmSize,AsmOutSize);
  395. AsmFlush;
  396. inc(StartIndex,AsmOutSize);
  397. dec(ToWrite,AsmOutSize);
  398. end;
  399. Move(s[StartIndex],OutBuf[OutCnt],ToWrite);
  400. inc(OutCnt,ToWrite);
  401. inc(AsmSize,ToWrite);
  402. end;
  403. constructor TExternalAssemblerOutputFile.Create(_owner: TExternalAssembler);
  404. begin
  405. owner:=_owner;
  406. linestart:=true;
  407. end;
  408. Procedure TExternalAssemblerOutputFile.AsmWrite(const c: char);
  409. begin
  410. if assigned(decorator) then
  411. AsmWriteFiltered(c)
  412. else
  413. begin
  414. if OutCnt+1>=AsmOutSize then
  415. AsmFlush;
  416. OutBuf[OutCnt]:=c;
  417. inc(OutCnt);
  418. inc(AsmSize);
  419. end;
  420. end;
  421. Procedure TExternalAssemblerOutputFile.AsmWrite(const s:string);
  422. begin
  423. if s='' then
  424. exit;
  425. if assigned(decorator) then
  426. AsmWriteFiltered(s)
  427. else
  428. begin
  429. if OutCnt+length(s)>=AsmOutSize then
  430. AsmFlush;
  431. Move(s[1],OutBuf[OutCnt],length(s));
  432. inc(OutCnt,length(s));
  433. inc(AsmSize,length(s));
  434. end;
  435. end;
  436. Procedure TExternalAssemblerOutputFile.AsmWrite(const s:ansistring);
  437. begin
  438. if s='' then
  439. exit;
  440. if assigned(decorator) then
  441. AsmWriteFiltered(s)
  442. else
  443. AsmWriteAnsiStringUnfiltered(s);
  444. end;
  445. procedure TExternalAssemblerOutputFile.AsmWriteLn(const c: char);
  446. begin
  447. AsmWrite(c);
  448. AsmLn;
  449. end;
  450. Procedure TExternalAssemblerOutputFile.AsmWriteLn(const s:string);
  451. begin
  452. AsmWrite(s);
  453. AsmLn;
  454. end;
  455. Procedure TExternalAssemblerOutputFile.AsmWriteLn(const s: ansistring);
  456. begin
  457. AsmWrite(s);
  458. AsmLn;
  459. end;
  460. Procedure TExternalAssemblerOutputFile.AsmWritePChar(p:pchar);
  461. var
  462. i,j : longint;
  463. begin
  464. i:=StrLen(p);
  465. if i=0 then
  466. exit;
  467. if assigned(decorator) then
  468. AsmWriteFiltered(p,i)
  469. else
  470. begin
  471. j:=i;
  472. while j>0 do
  473. begin
  474. i:=min(j,AsmOutSize);
  475. if OutCnt+i>=AsmOutSize then
  476. AsmFlush;
  477. Move(p[0],OutBuf[OutCnt],i);
  478. inc(OutCnt,i);
  479. inc(AsmSize,i);
  480. dec(j,i);
  481. p:=pchar(@p[i]);
  482. end;
  483. end;
  484. end;
  485. Procedure TExternalAssemblerOutputFile.AsmLn;
  486. var
  487. newline: pshortstring;
  488. newlineres: shortstring;
  489. index: longint;
  490. begin
  491. MaybeAddLinePostfix;
  492. if (cs_link_on_target in current_settings.globalswitches) then
  493. newline:=@target_info.newline
  494. else
  495. newline:=@source_info.newline;
  496. if assigned(decorator) then
  497. begin
  498. newlineres:=decorator.LineEnding(newline^);
  499. newline:=@newlineres;
  500. end;
  501. if OutCnt>=AsmOutSize-length(newline^) then
  502. AsmFlush;
  503. index:=1;
  504. repeat
  505. OutBuf[OutCnt]:=newline^[index];
  506. inc(OutCnt);
  507. inc(AsmSize);
  508. inc(index);
  509. until index>length(newline^);
  510. end;
  511. procedure TExternalAssemblerOutputFile.AsmCreate(Aplace:tcutplace);
  512. {$ifdef hasamiga}
  513. var
  514. tempFileName: TPathStr;
  515. {$endif}
  516. begin
  517. if owner.SmartAsm then
  518. owner.NextSmartName(Aplace);
  519. {$ifdef hasamiga}
  520. { on Amiga/MorphOS try to redirect .s files to the T: assign, which is
  521. for temp files, and usually (default setting) located in the RAM: drive.
  522. This highly improves assembling speed for complex projects like the
  523. compiler itself, especially on hardware with slow disk I/O.
  524. Consider this as a poor man's pipe on Amiga, because real pipe handling
  525. would be much more complex and error prone to implement. (KB) }
  526. if (([cs_asm_extern,cs_asm_leave,cs_link_on_target] * current_settings.globalswitches) = []) then
  527. begin
  528. { try to have an unique name for the .s file }
  529. tempFileName:=HexStr(GetProcessID shr 4,7)+ExtractFileName(owner.AsmFileName);
  530. {$ifndef morphos}
  531. { old Amiga RAM: handler only allows filenames up to 30 char }
  532. if Length(tempFileName) < 30 then
  533. {$endif}
  534. owner.AsmFileName:='T:'+tempFileName;
  535. end;
  536. {$endif}
  537. {$ifdef hasunix}
  538. if owner.DoPipe then
  539. begin
  540. if owner.SmartAsm then
  541. begin
  542. if (owner.SmartFilesCount<=1) then
  543. Message1(exec_i_assembling_smart,owner.name);
  544. end
  545. else
  546. Message1(exec_i_assembling_pipe,owner.AsmFileName);
  547. if checkverbosity(V_Executable) then
  548. comment(V_Executable,'Executing "'+maybequoted(owner.FindAssembler)+'" with command line "'+
  549. owner.MakeCmdLine+'"');
  550. POpen(outfile,maybequoted(owner.FindAssembler)+' '+owner.MakeCmdLine,'W');
  551. end
  552. else
  553. {$endif}
  554. begin
  555. Assign(outfile,owner.AsmFileName);
  556. {$push} {$I-}
  557. Rewrite(outfile,1);
  558. {$pop}
  559. if ioresult<>0 then
  560. begin
  561. fioerror:=true;
  562. Message1(exec_d_cant_create_asmfile,owner.AsmFileName);
  563. end;
  564. end;
  565. outcnt:=0;
  566. AsmSize:=0;
  567. AsmStartSize:=0;
  568. end;
  569. procedure TExternalAssemblerOutputFile.AsmClose;
  570. var
  571. f : file;
  572. FileAge : longint;
  573. begin
  574. AsmFlush;
  575. {$ifdef hasunix}
  576. if owner.DoPipe then
  577. begin
  578. if PClose(outfile) <> 0 then
  579. GenerateError;
  580. end
  581. else
  582. {$endif}
  583. begin
  584. {Touch Assembler time to ppu time is there is a ppufilename}
  585. if owner.ppufilename<>'' then
  586. begin
  587. Assign(f,owner.ppufilename);
  588. {$push} {$I-}
  589. reset(f,1);
  590. {$pop}
  591. if ioresult=0 then
  592. begin
  593. FileAge := FileGetDate(GetFileHandle(f));
  594. close(f);
  595. reset(outfile,1);
  596. FileSetDate(GetFileHandle(outFile),FileAge);
  597. end;
  598. end;
  599. close(outfile);
  600. end;
  601. end;
  602. {*****************************************************************************
  603. TExternalAssembler
  604. *****************************************************************************}
  605. function TExternalAssembler.single2str(d : single) : string;
  606. var
  607. hs : string;
  608. begin
  609. str(d,hs);
  610. { replace space with + }
  611. if hs[1]=' ' then
  612. hs[1]:='+';
  613. single2str:='0d'+hs
  614. end;
  615. function TExternalAssembler.double2str(d : double) : string;
  616. var
  617. hs : string;
  618. begin
  619. str(d,hs);
  620. { replace space with + }
  621. if hs[1]=' ' then
  622. hs[1]:='+';
  623. double2str:='0d'+hs
  624. end;
  625. function TExternalAssembler.extended2str(e : extended) : string;
  626. var
  627. hs : string;
  628. begin
  629. str(e,hs);
  630. { replace space with + }
  631. if hs[1]=' ' then
  632. hs[1]:='+';
  633. extended2str:='0d'+hs
  634. end;
  635. Function TExternalAssembler.DoPipe:boolean;
  636. begin
  637. {$ifdef hasunix}
  638. DoPipe:=(cs_asm_pipe in current_settings.globalswitches) and
  639. (([cs_asm_extern,cs_asm_leave,cs_link_on_target] * current_settings.globalswitches) = []) and
  640. ((asminfo^.id in [as_gas,as_ggas,as_darwin,as_powerpc_xcoff,as_clang,as_solaris_as]));
  641. {$else hasunix}
  642. DoPipe:=false;
  643. {$endif}
  644. end;
  645. function TExternalAssembler.CreateNewAsmWriter: TExternalAssemblerOutputFile;
  646. begin
  647. result:=TExternalAssemblerOutputFile.Create(self);
  648. end;
  649. Constructor TExternalAssembler.Create(info: pasminfo; smart: boolean);
  650. begin
  651. CreateWithWriter(info,CreateNewAsmWriter,true,smart);
  652. end;
  653. constructor TExternalAssembler.CreateWithWriter(info: pasminfo; wr: TExternalAssemblerOutputFile; freewriter,smart: boolean);
  654. begin
  655. inherited Create(info,smart);
  656. fwriter:=wr;
  657. ffreewriter:=freewriter;
  658. if SmartAsm then
  659. begin
  660. path:=FixPath(ChangeFileExt(AsmFileName,target_info.smartext),false);
  661. CreateSmartLinkPath(path);
  662. end;
  663. end;
  664. procedure TExternalAssembler.CreateSmartLinkPath(const s:TPathStr);
  665. procedure DeleteFilesWithExt(const AExt:string);
  666. var
  667. dir : TRawByteSearchRec;
  668. begin
  669. if findfirst(FixPath(s,false)+'*'+AExt,faAnyFile,dir) = 0 then
  670. begin
  671. repeat
  672. DeleteFile(s+source_info.dirsep+dir.name);
  673. until findnext(dir) <> 0;
  674. end;
  675. findclose(dir);
  676. end;
  677. var
  678. hs : TPathStr;
  679. begin
  680. if PathExists(s,false) then
  681. begin
  682. { the path exists, now we clean only all the .o and .s files }
  683. DeleteFilesWithExt(target_info.objext);
  684. DeleteFilesWithExt(target_info.asmext);
  685. end
  686. else
  687. begin
  688. hs:=s;
  689. if hs[length(hs)] in ['/','\'] then
  690. delete(hs,length(hs),1);
  691. {$push} {$I-}
  692. mkdir(hs);
  693. {$pop}
  694. if ioresult<>0 then;
  695. end;
  696. end;
  697. const
  698. lastas : byte=255;
  699. var
  700. LastASBin : TCmdStr;
  701. Function TExternalAssembler.FindAssembler:string;
  702. var
  703. asfound : boolean;
  704. UtilExe : string;
  705. asmbin : TCmdStr;
  706. begin
  707. asfound:=false;
  708. asmbin:=asminfo^.asmbin;
  709. if (af_llvm in asminfo^.flags) then
  710. asmbin:=asmbin+llvmutilssuffix;
  711. if cs_link_on_target in current_settings.globalswitches then
  712. begin
  713. { If linking on target, don't add any path PM }
  714. FindAssembler:=utilsprefix+ChangeFileExt(asmbin,target_info.exeext);
  715. exit;
  716. end
  717. else
  718. UtilExe:=utilsprefix+ChangeFileExt(asmbin,source_info.exeext);
  719. if lastas<>ord(asminfo^.id) then
  720. begin
  721. lastas:=ord(asminfo^.id);
  722. { is an assembler passed ? }
  723. if utilsdirectory<>'' then
  724. asfound:=FindFile(UtilExe,utilsdirectory,false,LastASBin);
  725. if not AsFound then
  726. asfound:=FindExe(UtilExe,false,LastASBin);
  727. if (not asfound) and not(cs_asm_extern in current_settings.globalswitches) then
  728. begin
  729. Message1(exec_e_assembler_not_found,LastASBin);
  730. current_settings.globalswitches:=current_settings.globalswitches+[cs_asm_extern];
  731. end;
  732. if asfound then
  733. Message1(exec_t_using_assembler,LastASBin);
  734. end;
  735. FindAssembler:=LastASBin;
  736. end;
  737. Function TExternalAssembler.CallAssembler(const command:string; const para:TCmdStr):Boolean;
  738. var
  739. DosExitCode : Integer;
  740. begin
  741. result:=true;
  742. if (cs_asm_extern in current_settings.globalswitches) then
  743. begin
  744. if SmartAsm then
  745. AsmRes.AddAsmCommand(command,para,Name+'('+TosTr(SmartFilesCount)+')')
  746. else
  747. AsmRes.AddAsmCommand(command,para,name);
  748. exit;
  749. end;
  750. try
  751. FlushOutput;
  752. DosExitCode:=RequotedExecuteProcess(command,para);
  753. if DosExitCode<>0
  754. then begin
  755. Message1(exec_e_error_while_assembling,tostr(dosexitcode));
  756. result:=false;
  757. end;
  758. except on E:EOSError do
  759. begin
  760. Message1(exec_e_cant_call_assembler,tostr(E.ErrorCode));
  761. current_settings.globalswitches:=current_settings.globalswitches+[cs_asm_extern];
  762. result:=false;
  763. end;
  764. end;
  765. end;
  766. Function TExternalAssembler.DoAssemble:boolean;
  767. begin
  768. result:=true;
  769. if DoPipe then
  770. exit;
  771. if not(cs_asm_extern in current_settings.globalswitches) then
  772. begin
  773. if SmartAsm then
  774. begin
  775. if (SmartFilesCount<=1) then
  776. Message1(exec_i_assembling_smart,name);
  777. end
  778. else
  779. Message1(exec_i_assembling,name);
  780. end;
  781. repeat
  782. result:=CallAssembler(FindAssembler,MakeCmdLine)
  783. until not(result) or not RerunAssembler;
  784. if result then
  785. writer.RemoveAsm
  786. else
  787. GenerateError;
  788. end;
  789. function TExternalAssembler.MakeCmdLine: TCmdStr;
  790. function section_high_bound:longint;
  791. var
  792. alt : tasmlisttype;
  793. begin
  794. result:=0;
  795. for alt:=low(tasmlisttype) to high(tasmlisttype) do
  796. result:=result+current_asmdata.asmlists[alt].section_count;
  797. end;
  798. const
  799. min_big_obj_section_count = $7fff;
  800. begin
  801. result:=asminfo^.asmcmd;
  802. { for Xcode 7.x and later }
  803. if MacOSXVersionMin<>'' then
  804. Replace(result,'$DARWINVERSION','-mmacosx-version-min='+MacOSXVersionMin)
  805. else if iPhoneOSVersionMin<>'' then
  806. Replace(result,'$DARWINVERSION','-miphoneos-version-min='+iPhoneOSVersionMin)
  807. else
  808. Replace(result,'$DARWINVERSION','');
  809. {$ifdef arm}
  810. if (target_info.system=system_arm_darwin) then
  811. Replace(result,'$ARCH',lower(cputypestr[current_settings.cputype]));
  812. {$endif arm}
  813. if (cs_link_on_target in current_settings.globalswitches) then
  814. begin
  815. Replace(result,'$ASM',maybequoted(ScriptFixFileName(AsmFileName)));
  816. Replace(result,'$OBJ',maybequoted(ScriptFixFileName(ObjFileName)));
  817. end
  818. else
  819. begin
  820. {$ifdef hasunix}
  821. if DoPipe then
  822. if asminfo^.id<>as_clang then
  823. Replace(result,'$ASM','')
  824. else
  825. Replace(result,'$ASM','-')
  826. else
  827. {$endif}
  828. Replace(result,'$ASM',maybequoted(AsmFileName));
  829. Replace(result,'$OBJ',maybequoted(ObjFileName));
  830. end;
  831. if (cs_create_pic in current_settings.moduleswitches) then
  832. Replace(result,'$PIC','-KPIC')
  833. else
  834. Replace(result,'$PIC','');
  835. if (cs_asm_source in current_settings.globalswitches) then
  836. Replace(result,'$NOWARN','')
  837. else
  838. Replace(result,'$NOWARN','-W');
  839. if target_info.endian=endian_little then
  840. Replace(result,'$ENDIAN','-mlittle')
  841. else
  842. Replace(result,'$ENDIAN','-mbig');
  843. { as we don't keep track of the amount of sections we created we simply
  844. enable Big Obj COFF files always for targets that need them }
  845. if (cs_asm_pre_binutils_2_25 in current_settings.globalswitches) or
  846. not (target_info.system in systems_all_windows+systems_nativent-[system_i8086_win16]) or
  847. (section_high_bound<min_big_obj_section_count) then
  848. Replace(result,'$BIGOBJ','')
  849. else
  850. Replace(result,'$BIGOBJ','-mbig-obj');
  851. Replace(result,'$EXTRAOPT',asmextraopt);
  852. end;
  853. function TExternalAssembler.RerunAssembler: boolean;
  854. begin
  855. result:=false;
  856. end;
  857. procedure TExternalAssembler.WriteSourceLine(hp: tailineinfo);
  858. var
  859. module : tmodule;
  860. begin
  861. { load infile }
  862. if (lastfileinfo.moduleindex<>hp.fileinfo.moduleindex) or
  863. (lastfileinfo.fileindex<>hp.fileinfo.fileindex) then
  864. begin
  865. { in case of a generic the module can be different }
  866. if current_module.unit_index=hp.fileinfo.moduleindex then
  867. module:=current_module
  868. else
  869. module:=get_module(hp.fileinfo.moduleindex);
  870. { during the compilation of the system unit there are cases when
  871. the fileinfo contains just zeros => invalid }
  872. if assigned(module) then
  873. infile:=module.sourcefiles.get_file(hp.fileinfo.fileindex)
  874. else
  875. infile:=nil;
  876. if assigned(infile) then
  877. begin
  878. { open only if needed !! }
  879. if (cs_asm_source in current_settings.globalswitches) then
  880. infile.open;
  881. end;
  882. { avoid unnecessary reopens of the same file !! }
  883. lastfileinfo.fileindex:=hp.fileinfo.fileindex;
  884. lastfileinfo.moduleindex:=hp.fileinfo.moduleindex;
  885. { be sure to change line !! }
  886. lastfileinfo.line:=-1;
  887. end;
  888. { write source }
  889. if (cs_asm_source in current_settings.globalswitches) and
  890. assigned(infile) then
  891. begin
  892. if (infile<>lastinfile) then
  893. begin
  894. writer.AsmWriteLn(asminfo^.comment+'['+infile.name+']');
  895. if assigned(lastinfile) then
  896. lastinfile.close;
  897. end;
  898. if (hp.fileinfo.line<>lastfileinfo.line) and
  899. (hp.fileinfo.line<infile.maxlinebuf) then
  900. begin
  901. if (hp.fileinfo.line<>0) and
  902. (infile.linebuf^[hp.fileinfo.line]>=0) then
  903. writer.AsmWriteLn(asminfo^.comment+'['+tostr(hp.fileinfo.line)+'] '+
  904. fixline(infile.GetLineStr(hp.fileinfo.line)));
  905. { set it to a negative value !
  906. to make that is has been read already !! PM }
  907. if (infile.linebuf^[hp.fileinfo.line]>=0) then
  908. infile.linebuf^[hp.fileinfo.line]:=-infile.linebuf^[hp.fileinfo.line]-1;
  909. end;
  910. end;
  911. lastfileinfo:=hp.fileinfo;
  912. lastinfile:=infile;
  913. end;
  914. procedure TExternalAssembler.WriteTempalloc(hp: tai_tempalloc);
  915. begin
  916. {$ifdef EXTDEBUG}
  917. if assigned(hp.problem) then
  918. writer.AsmWriteLn(asminfo^.comment+'Temp '+tostr(hp.temppos)+','+
  919. tostr(hp.tempsize)+' '+hp.problem^)
  920. else
  921. {$endif EXTDEBUG}
  922. writer.AsmWriteLn(asminfo^.comment+'Temp '+tostr(hp.temppos)+','+
  923. tostr(hp.tempsize)+' '+tempallocstr[hp.allocation]);
  924. end;
  925. procedure TExternalAssembler.WriteRealConstAsBytes(hp: tai_realconst; const dbdir: string; do_line: boolean);
  926. var
  927. pdata: pbyte;
  928. index, step, swapmask, count: longint;
  929. ssingle: single;
  930. ddouble: double;
  931. ccomp: comp;
  932. {$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)}
  933. eextended: extended;
  934. {$else}
  935. {$ifdef FPC_SOFT_FPUX80}
  936. eextended: floatx80;
  937. {$endif}
  938. {$endif cpuextended}
  939. begin
  940. if do_line then
  941. begin
  942. case tai_realconst(hp).realtyp of
  943. aitrealconst_s32bit:
  944. writer.AsmWriteLn(asminfo^.comment+'value: '+single2str(tai_realconst(hp).value.s32val));
  945. aitrealconst_s64bit:
  946. writer.AsmWriteLn(asminfo^.comment+'value: '+double2str(tai_realconst(hp).value.s64val));
  947. {$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)}
  948. { can't write full 80 bit floating point constants yet on non-x86 }
  949. aitrealconst_s80bit:
  950. writer.AsmWriteLn(asminfo^.comment+'value: '+extended2str(tai_realconst(hp).value.s80val));
  951. {$else}
  952. {$ifdef FPC_SOFT_FPUX80}
  953. {$push}{$warn 6018 off} { Unreachable code due to compile time evaluation }
  954. aitrealconst_s80bit:
  955. begin
  956. if sizeof(tai_realconst(hp).value.s80val) = sizeof(double) then
  957. writer.AsmWriteLn(asminfo^.comment+'value: '+double2str(tai_realconst(hp).value.s80val))
  958. else if sizeof(tai_realconst(hp).value.s80val) = sizeof(single) then
  959. writer.AsmWriteLn(asminfo^.comment+'value: '+single2str(tai_realconst(hp).value.s80val))
  960. else
  961. internalerror(2017091901);
  962. end;
  963. {$pop}
  964. {$endif}
  965. {$endif cpuextended}
  966. aitrealconst_s64comp:
  967. writer.AsmWriteLn(asminfo^.comment+'value: '+extended2str(tai_realconst(hp).value.s64compval));
  968. else
  969. internalerror(2014050604);
  970. end;
  971. end;
  972. writer.AsmWrite(dbdir);
  973. { generic float writing code: get start address of value, then write
  974. byte by byte. Can't use fields directly, because e.g ts64comp is
  975. defined as extended on x86 }
  976. case tai_realconst(hp).realtyp of
  977. aitrealconst_s32bit:
  978. begin
  979. ssingle:=single(tai_realconst(hp).value.s32val);
  980. pdata:=@ssingle;
  981. end;
  982. aitrealconst_s64bit:
  983. begin
  984. ddouble:=double(tai_realconst(hp).value.s64val);
  985. pdata:=@ddouble;
  986. end;
  987. {$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)}
  988. { can't write full 80 bit floating point constants yet on non-x86 }
  989. aitrealconst_s80bit:
  990. begin
  991. eextended:=extended(tai_realconst(hp).value.s80val);
  992. pdata:=@eextended;
  993. end;
  994. {$else}
  995. {$ifdef FPC_SOFT_FPUX80}
  996. {$push}{$warn 6018 off} { Unreachable code due to compile time evaluation }
  997. aitrealconst_s80bit:
  998. begin
  999. if sizeof(tai_realconst(hp).value.s80val) = sizeof(double) then
  1000. eextended:=float64_to_floatx80(float64(double(tai_realconst(hp).value.s80val)))
  1001. else if sizeof(tai_realconst(hp).value.s80val) = sizeof(single) then
  1002. eextended:=float32_to_floatx80(float32(single(tai_realconst(hp).value.s80val)))
  1003. else
  1004. internalerror(2017091901);
  1005. pdata:=@eextended;
  1006. end;
  1007. {$pop}
  1008. {$endif}
  1009. {$endif cpuextended}
  1010. aitrealconst_s64comp:
  1011. begin
  1012. ccomp:=comp(tai_realconst(hp).value.s64compval);
  1013. pdata:=@ccomp;
  1014. end;
  1015. else
  1016. internalerror(2014051001);
  1017. end;
  1018. count:=tai_realconst(hp).datasize;
  1019. { write bytes in inverse order if source and target endianess don't
  1020. match }
  1021. if source_info.endian<>target_info.endian then
  1022. begin
  1023. { go from back to front }
  1024. index:=count-1;
  1025. step:=-1;
  1026. end
  1027. else
  1028. begin
  1029. index:=0;
  1030. step:=1;
  1031. end;
  1032. {$ifdef ARM}
  1033. { ARM-specific: low and high dwords of a double may be swapped }
  1034. if tai_realconst(hp).formatoptions=fo_hiloswapped then
  1035. begin
  1036. { only supported for double }
  1037. if tai_realconst(hp).datasize<>8 then
  1038. internalerror(2014050605);
  1039. { switch bit of the index so that the words are written in
  1040. the opposite order }
  1041. swapmask:=4;
  1042. end
  1043. else
  1044. {$endif ARM}
  1045. swapmask:=0;
  1046. repeat
  1047. writer.AsmWrite(tostr(pdata[index xor swapmask]));
  1048. inc(index,step);
  1049. dec(count);
  1050. if count<>0 then
  1051. writer.AsmWrite(',');
  1052. until count=0;
  1053. { padding }
  1054. for count:=tai_realconst(hp).datasize+1 to tai_realconst(hp).savesize do
  1055. writer.AsmWrite(',0');
  1056. writer.AsmLn;
  1057. end;
  1058. procedure TExternalAssembler.WriteTree(p:TAsmList);
  1059. begin
  1060. end;
  1061. procedure TExternalAssembler.WriteAsmList;
  1062. begin
  1063. end;
  1064. procedure TExternalAssembler.MakeObject;
  1065. begin
  1066. writer.AsmCreate(cut_normal);
  1067. FillChar(lastfileinfo, sizeof(lastfileinfo), 0);
  1068. lastfileinfo.line := -1;
  1069. lastinfile := nil;
  1070. lastsectype := sec_none;
  1071. WriteAsmList;
  1072. writer.AsmClose;
  1073. if not(writer.ioerror) then
  1074. DoAssemble;
  1075. end;
  1076. destructor TExternalAssembler.Destroy;
  1077. begin
  1078. if ffreewriter then
  1079. writer.Free;
  1080. inherited;
  1081. end;
  1082. {*****************************************************************************
  1083. TInternalAssembler
  1084. *****************************************************************************}
  1085. constructor TInternalAssembler.Create(info: pasminfo; smart: boolean);
  1086. begin
  1087. inherited;
  1088. ObjOutput:=nil;
  1089. ObjData:=nil;
  1090. SmartAsm:=smart;
  1091. end;
  1092. destructor TInternalAssembler.destroy;
  1093. begin
  1094. if assigned(ObjData) then
  1095. ObjData.free;
  1096. if assigned(ObjOutput) then
  1097. ObjOutput.free;
  1098. end;
  1099. procedure TInternalAssembler.WriteStab(p:pchar);
  1100. function consumecomma(var p:pchar):boolean;
  1101. begin
  1102. while (p^=' ') do
  1103. inc(p);
  1104. result:=(p^=',');
  1105. inc(p);
  1106. end;
  1107. function consumenumber(var p:pchar;out value:longint):boolean;
  1108. var
  1109. hs : string;
  1110. len,
  1111. code : integer;
  1112. begin
  1113. value:=0;
  1114. while (p^=' ') do
  1115. inc(p);
  1116. len:=0;
  1117. while (p^ in ['0'..'9']) do
  1118. begin
  1119. inc(len);
  1120. hs[len]:=p^;
  1121. inc(p);
  1122. end;
  1123. if len>0 then
  1124. begin
  1125. hs[0]:=chr(len);
  1126. val(hs,value,code);
  1127. end
  1128. else
  1129. code:=-1;
  1130. result:=(code=0);
  1131. end;
  1132. function consumeoffset(var p:pchar;out relocsym:tobjsymbol;out value:longint):boolean;
  1133. var
  1134. hs : string;
  1135. len,
  1136. code : integer;
  1137. pstart : pchar;
  1138. sym : tobjsymbol;
  1139. exprvalue : longint;
  1140. gotmin,
  1141. have_first_symbol,
  1142. have_second_symbol,
  1143. dosub : boolean;
  1144. begin
  1145. result:=false;
  1146. value:=0;
  1147. relocsym:=nil;
  1148. gotmin:=false;
  1149. have_first_symbol:=false;
  1150. have_second_symbol:=false;
  1151. repeat
  1152. dosub:=false;
  1153. exprvalue:=0;
  1154. if gotmin then
  1155. begin
  1156. dosub:=true;
  1157. gotmin:=false;
  1158. end;
  1159. while (p^=' ') do
  1160. inc(p);
  1161. case p^ of
  1162. #0 :
  1163. break;
  1164. ' ' :
  1165. inc(p);
  1166. '0'..'9' :
  1167. begin
  1168. len:=0;
  1169. while (p^ in ['0'..'9']) do
  1170. begin
  1171. inc(len);
  1172. hs[len]:=p^;
  1173. inc(p);
  1174. end;
  1175. hs[0]:=chr(len);
  1176. val(hs,exprvalue,code);
  1177. if code<>0 then
  1178. internalerror(200702251);
  1179. end;
  1180. '.','_',
  1181. 'A'..'Z',
  1182. 'a'..'z' :
  1183. begin
  1184. pstart:=p;
  1185. while not(p^ in [#0,' ','-','+']) do
  1186. inc(p);
  1187. len:=p-pstart;
  1188. if len>255 then
  1189. internalerror(200509187);
  1190. move(pstart^,hs[1],len);
  1191. hs[0]:=chr(len);
  1192. sym:=objdata.symbolref(hs);
  1193. { Second symbol? }
  1194. if assigned(relocsym) then
  1195. begin
  1196. if have_second_symbol then
  1197. internalerror(2007032201);
  1198. have_second_symbol:=true;
  1199. if not have_first_symbol then
  1200. internalerror(2007032202);
  1201. { second symbol should substracted to first }
  1202. if not dosub then
  1203. internalerror(2007032203);
  1204. if (relocsym.objsection<>sym.objsection) then
  1205. internalerror(2005091810);
  1206. exprvalue:=relocsym.address-sym.address;
  1207. relocsym:=nil;
  1208. dosub:=false;
  1209. end
  1210. else
  1211. begin
  1212. relocsym:=sym;
  1213. if assigned(sym.objsection) then
  1214. begin
  1215. { first symbol should be + }
  1216. if not have_first_symbol and dosub then
  1217. internalerror(2007032204);
  1218. have_first_symbol:=true;
  1219. end;
  1220. end;
  1221. end;
  1222. '+' :
  1223. begin
  1224. { nothing, by default addition is done }
  1225. inc(p);
  1226. end;
  1227. '-' :
  1228. begin
  1229. gotmin:=true;
  1230. inc(p);
  1231. end;
  1232. else
  1233. internalerror(200509189);
  1234. end;
  1235. if dosub then
  1236. dec(value,exprvalue)
  1237. else
  1238. inc(value,exprvalue);
  1239. until false;
  1240. result:=true;
  1241. end;
  1242. var
  1243. stabstrlen,
  1244. ofs,
  1245. nline,
  1246. nidx,
  1247. nother,
  1248. i : longint;
  1249. stab : TObjStabEntry;
  1250. relocsym : TObjSymbol;
  1251. pstr,
  1252. pcurr,
  1253. pendquote : pchar;
  1254. oldsec : TObjSection;
  1255. begin
  1256. pcurr:=nil;
  1257. pstr:=nil;
  1258. pendquote:=nil;
  1259. relocsym:=nil;
  1260. ofs:=0;
  1261. { Parse string part }
  1262. if (p[0]='"') then
  1263. begin
  1264. pstr:=@p[1];
  1265. { Ignore \" inside the string }
  1266. i:=1;
  1267. while not((p[i]='"') and (p[i-1]<>'\')) and
  1268. (p[i]<>#0) do
  1269. inc(i);
  1270. pendquote:=@p[i];
  1271. pendquote^:=#0;
  1272. pcurr:=@p[i+1];
  1273. if not consumecomma(pcurr) then
  1274. internalerror(200509181);
  1275. end
  1276. else
  1277. pcurr:=p;
  1278. { When in pass 1 then only alloc and leave }
  1279. if ObjData.currpass=1 then
  1280. begin
  1281. ObjData.StabsSec.Alloc(sizeof(TObjStabEntry));
  1282. if assigned(pstr) and (pstr[0]<>#0) then
  1283. ObjData.StabStrSec.Alloc(strlen(pstr)+1);
  1284. end
  1285. else
  1286. begin
  1287. { Stabs format: nidx,nother,nline[,offset] }
  1288. if not consumenumber(pcurr,nidx) then
  1289. internalerror(200509182);
  1290. if not consumecomma(pcurr) then
  1291. internalerror(200509183);
  1292. if not consumenumber(pcurr,nother) then
  1293. internalerror(200509184);
  1294. if not consumecomma(pcurr) then
  1295. internalerror(200509185);
  1296. if not consumenumber(pcurr,nline) then
  1297. internalerror(200509186);
  1298. if consumecomma(pcurr) then
  1299. consumeoffset(pcurr,relocsym,ofs);
  1300. { Generate stab entry }
  1301. if assigned(pstr) and (pstr[0]<>#0) then
  1302. begin
  1303. stabstrlen:=strlen(pstr);
  1304. {$ifdef optimizestabs}
  1305. StabStrEntry:=nil;
  1306. if (nidx=N_SourceFile) or (nidx=N_IncludeFile) then
  1307. begin
  1308. hs:=strpas(pstr);
  1309. StabstrEntry:=StabStrDict.Find(hs);
  1310. if not assigned(StabstrEntry) then
  1311. begin
  1312. StabstrEntry:=TStabStrEntry.Create(hs);
  1313. StabstrEntry:=StabStrSec.Size;
  1314. StabStrDict.Insert(StabstrEntry);
  1315. { generate new stab }
  1316. StabstrEntry:=nil;
  1317. end;
  1318. end;
  1319. if assigned(StabstrEntry) then
  1320. stab.strpos:=StabstrEntry.strpos
  1321. else
  1322. {$endif optimizestabs}
  1323. begin
  1324. stab.strpos:=ObjData.StabStrSec.Size;
  1325. ObjData.StabStrSec.write(pstr^,stabstrlen+1);
  1326. end;
  1327. end
  1328. else
  1329. stab.strpos:=0;
  1330. stab.ntype:=byte(nidx);
  1331. stab.ndesc:=word(nline);
  1332. stab.nother:=byte(nother);
  1333. stab.nvalue:=ofs;
  1334. { Write the stab first without the value field. Then
  1335. write a the value field with relocation }
  1336. oldsec:=ObjData.CurrObjSec;
  1337. ObjData.SetSection(ObjData.StabsSec);
  1338. ObjData.Writebytes(stab,sizeof(TObjStabEntry)-4);
  1339. ObjData.Writereloc(stab.nvalue,4,relocsym,RELOC_ABSOLUTE32);
  1340. ObjData.setsection(oldsec);
  1341. end;
  1342. if assigned(pendquote) then
  1343. pendquote^:='"';
  1344. end;
  1345. function TInternalAssembler.MaybeNextList(var hp:Tai):boolean;
  1346. begin
  1347. { maybe end of list }
  1348. while not assigned(hp) do
  1349. begin
  1350. if currlistidx<lists then
  1351. begin
  1352. inc(currlistidx);
  1353. currlist:=list[currlistidx];
  1354. hp:=Tai(currList.first);
  1355. end
  1356. else
  1357. begin
  1358. MaybeNextList:=false;
  1359. exit;
  1360. end;
  1361. end;
  1362. MaybeNextList:=true;
  1363. end;
  1364. function TInternalAssembler.SetIndirectToSymbol(hp: Tai; const indirectname: string): Boolean;
  1365. var
  1366. objsym : TObjSymbol;
  1367. indsym : TObjSymbol;
  1368. begin
  1369. Result:=
  1370. Assigned(hp) and
  1371. (hp.typ=ait_symbol);
  1372. if not Result then
  1373. Exit;
  1374. objsym:=Objdata.SymbolRef(tai_symbol(hp).sym);
  1375. objsym.size:=0;
  1376. indsym := TObjSymbol(ObjData.ObjSymbolList.Find(indirectname));
  1377. if not Assigned(indsym) then
  1378. begin
  1379. { it's possible that indirect symbol is not present in the list,
  1380. so we must create it as undefined }
  1381. indsym:=ObjData.CObjSymbol.Create(ObjData.ObjSymbolList, indirectname);
  1382. indsym.typ:=AT_NONE;
  1383. indsym.bind:=AB_NONE;
  1384. end;
  1385. objsym.indsymbol:=indsym;
  1386. Result:=true;
  1387. end;
  1388. function TInternalAssembler.TreePass0(hp:Tai):Tai;
  1389. var
  1390. objsym,
  1391. objsymend : TObjSymbol;
  1392. cpu: tcputype;
  1393. eabi_section, TmpSection: TObjSection;
  1394. begin
  1395. while assigned(hp) do
  1396. begin
  1397. case hp.typ of
  1398. ait_align :
  1399. begin
  1400. if tai_align_abstract(hp).aligntype>1 then
  1401. begin
  1402. { always use the maximum fillsize in this pass to avoid possible
  1403. short jumps to become out of range }
  1404. Tai_align_abstract(hp).fillsize:=Tai_align_abstract(hp).aligntype;
  1405. ObjData.alloc(Tai_align_abstract(hp).fillsize);
  1406. { may need to increase alignment of section }
  1407. if tai_align_abstract(hp).aligntype>ObjData.CurrObjSec.secalign then
  1408. ObjData.CurrObjSec.secalign:=tai_align_abstract(hp).aligntype;
  1409. end
  1410. else
  1411. Tai_align_abstract(hp).fillsize:=0;
  1412. end;
  1413. ait_datablock :
  1414. begin
  1415. {$ifdef USE_COMM_IN_BSS}
  1416. if writingpackages and
  1417. Tai_datablock(hp).is_global then
  1418. ObjData.SymbolDefine(Tai_datablock(hp).sym)
  1419. else
  1420. {$endif USE_COMM_IN_BSS}
  1421. begin
  1422. ObjData.allocalign(used_align(size_2_align(Tai_datablock(hp).size),0,ObjData.CurrObjSec.secalign));
  1423. ObjData.SymbolDefine(Tai_datablock(hp).sym);
  1424. ObjData.alloc(Tai_datablock(hp).size);
  1425. end;
  1426. end;
  1427. ait_realconst:
  1428. ObjData.alloc(tai_realconst(hp).savesize);
  1429. ait_const:
  1430. begin
  1431. { if symbols are provided we can calculate the value for relative symbols.
  1432. This is required for length calculation of leb128 constants }
  1433. if assigned(tai_const(hp).sym) then
  1434. begin
  1435. objsym:=Objdata.SymbolRef(tai_const(hp).sym);
  1436. { objsym already defined and there is endsym? }
  1437. if assigned(objsym.objsection) and assigned(tai_const(hp).endsym) then
  1438. begin
  1439. objsymend:=Objdata.SymbolRef(tai_const(hp).endsym);
  1440. { objsymend already defined? }
  1441. if assigned(objsymend.objsection) then
  1442. begin
  1443. if objsymend.objsection<>objsym.objsection then
  1444. begin
  1445. { leb128 relative constants are not relocatable, but other types are,
  1446. given that objsym belongs to the current section. }
  1447. if (Tai_const(hp).consttype in [aitconst_uleb128bit,aitconst_sleb128bit]) or
  1448. (objsym.objsection<>ObjData.CurrObjSec) then
  1449. InternalError(200404124);
  1450. end
  1451. {$push} {$R-}{$Q-}
  1452. else
  1453. Tai_const(hp).value:=objsymend.address-objsym.address+Tai_const(hp).symofs;
  1454. end;
  1455. {$pop}
  1456. end;
  1457. end;
  1458. ObjData.alloc(tai_const(hp).size);
  1459. end;
  1460. ait_directive:
  1461. begin
  1462. case tai_directive(hp).directive of
  1463. asd_indirect_symbol:
  1464. { handled in TreePass1 }
  1465. ;
  1466. asd_lazy_reference:
  1467. begin
  1468. if tai_directive(hp).name='' then
  1469. Internalerror(2009112101);
  1470. objsym:=ObjData.symbolref(tai_directive(hp).name);
  1471. objsym.bind:=AB_LAZY;
  1472. end;
  1473. asd_reference:
  1474. { ignore for now, but should be added}
  1475. ;
  1476. asd_cpu:
  1477. begin
  1478. ObjData.CPUType:=cpu_none;
  1479. for cpu:=low(tcputype) to high(tcputype) do
  1480. if cputypestr[cpu]=tai_directive(hp).name then
  1481. begin
  1482. ObjData.CPUType:=cpu;
  1483. break;
  1484. end;
  1485. end;
  1486. {$ifdef OMFOBJSUPPORT}
  1487. asd_omf_linnum_line:
  1488. { ignore for now, but should be added}
  1489. ;
  1490. {$endif OMFOBJSUPPORT}
  1491. {$ifdef ARM}
  1492. asd_thumb_func:
  1493. ObjData.ThumbFunc:=true;
  1494. asd_code:
  1495. { ai_directive(hp).name can be only 16 or 32, this is checked by the reader }
  1496. ObjData.ThumbFunc:=tai_directive(hp).name='16';
  1497. {$endif ARM}
  1498. {$ifdef RISCV}
  1499. asd_option:
  1500. internalerror(2019031701);
  1501. {$endif RISCV}
  1502. else
  1503. internalerror(2010011101);
  1504. end;
  1505. end;
  1506. ait_section:
  1507. begin
  1508. if Tai_section(hp).sectype=sec_user then
  1509. ObjData.CreateSection(Tai_section(hp).sectype,Tai_section(hp).secflags,Tai_section(hp).secprogbits,Tai_section(hp).name^,Tai_section(hp).secorder)
  1510. else
  1511. ObjData.CreateSection(Tai_section(hp).sectype,Tai_section(hp).name^,Tai_section(hp).secorder);
  1512. Tai_section(hp).sec:=ObjData.CurrObjSec;
  1513. end;
  1514. ait_symbol :
  1515. begin
  1516. { needs extra support in the internal assembler }
  1517. { the value is just ignored }
  1518. {if tai_symbol(hp).has_value then
  1519. internalerror(2009090804); ;}
  1520. ObjData.SymbolDefine(Tai_symbol(hp).sym);
  1521. end;
  1522. ait_label :
  1523. ObjData.SymbolDefine(Tai_label(hp).labsym);
  1524. ait_string :
  1525. ObjData.alloc(Tai_string(hp).len);
  1526. ait_instruction :
  1527. begin
  1528. { reset instructions which could change in pass 2 }
  1529. Taicpu(hp).resetpass2;
  1530. ObjData.alloc(Taicpu(hp).Pass1(ObjData));
  1531. end;
  1532. ait_cutobject :
  1533. if SmartAsm then
  1534. break;
  1535. ait_eabi_attribute :
  1536. begin
  1537. eabi_section:=ObjData.findsection('.ARM.attributes');
  1538. if not(assigned(eabi_section)) then
  1539. begin
  1540. TmpSection:=ObjData.CurrObjSec;
  1541. ObjData.CreateSection(sec_arm_attribute,[],SPB_ARM_ATTRIBUTES,'',secorder_default);
  1542. eabi_section:=ObjData.CurrObjSec;
  1543. ObjData.setsection(TmpSection);
  1544. end;
  1545. if eabi_section.Size=0 then
  1546. eabi_section.alloc(16);
  1547. eabi_section.alloc(LengthUleb128(tai_eabi_attribute(hp).tag));
  1548. case tai_eabi_attribute(hp).eattr_typ of
  1549. eattrtype_dword:
  1550. eabi_section.alloc(LengthUleb128(tai_eabi_attribute(hp).value));
  1551. eattrtype_ntbs:
  1552. eabi_section.alloc(Length(tai_eabi_attribute(hp).valuestr^)+1);
  1553. else
  1554. Internalerror(2019100701);
  1555. end;
  1556. end;
  1557. else
  1558. ;
  1559. end;
  1560. hp:=Tai(hp.next);
  1561. end;
  1562. TreePass0:=hp;
  1563. end;
  1564. function TInternalAssembler.TreePass1(hp:Tai):Tai;
  1565. var
  1566. objsym,
  1567. objsymend : TObjSymbol;
  1568. cpu: tcputype;
  1569. eabi_section: TObjSection;
  1570. begin
  1571. while assigned(hp) do
  1572. begin
  1573. case hp.typ of
  1574. ait_align :
  1575. begin
  1576. if tai_align_abstract(hp).aligntype>1 then
  1577. begin
  1578. { here we must determine the fillsize which is used in pass2 }
  1579. Tai_align_abstract(hp).fillsize:=align(ObjData.CurrObjSec.Size,Tai_align_abstract(hp).aligntype)-
  1580. ObjData.CurrObjSec.Size;
  1581. { maximum number of bytes for alignment exeeded? }
  1582. if (Tai_align_abstract(hp).aligntype<>Tai_align_abstract(hp).maxbytes) and
  1583. (Tai_align_abstract(hp).fillsize>Tai_align_abstract(hp).maxbytes) then
  1584. Tai_align_abstract(hp).fillsize:=align(ObjData.CurrObjSec.Size,Byte(Tai_align_abstract(hp).aligntype div 2))-
  1585. ObjData.CurrObjSec.Size;
  1586. ObjData.alloc(Tai_align_abstract(hp).fillsize);
  1587. end;
  1588. end;
  1589. ait_datablock :
  1590. begin
  1591. if (oso_data in ObjData.CurrObjSec.secoptions) and
  1592. not (oso_sparse_data in ObjData.CurrObjSec.secoptions) then
  1593. Message(asmw_e_alloc_data_only_in_bss);
  1594. {$ifdef USE_COMM_IN_BSS}
  1595. if writingpackages and
  1596. Tai_datablock(hp).is_global then
  1597. begin
  1598. objsym:=ObjData.SymbolDefine(Tai_datablock(hp).sym);
  1599. objsym.size:=Tai_datablock(hp).size;
  1600. objsym.bind:=AB_COMMON;
  1601. objsym.alignment:=needtowritealignmentalsoforELF;
  1602. end
  1603. else
  1604. {$endif USE_COMM_IN_BSS}
  1605. begin
  1606. ObjData.allocalign(used_align(size_2_align(Tai_datablock(hp).size),0,ObjData.CurrObjSec.secalign));
  1607. objsym:=ObjData.SymbolDefine(Tai_datablock(hp).sym);
  1608. objsym.size:=Tai_datablock(hp).size;
  1609. ObjData.alloc(Tai_datablock(hp).size);
  1610. end;
  1611. end;
  1612. ait_realconst:
  1613. ObjData.alloc(tai_realconst(hp).savesize);
  1614. ait_const:
  1615. begin
  1616. { Recalculate relative symbols }
  1617. if assigned(tai_const(hp).sym) and
  1618. assigned(tai_const(hp).endsym) then
  1619. begin
  1620. objsym:=Objdata.SymbolRef(tai_const(hp).sym);
  1621. objsymend:=Objdata.SymbolRef(tai_const(hp).endsym);
  1622. if Tai_const(hp).consttype in [aitconst_gottpoff,aitconst_tlsgd,aitconst_tlsdesc] then
  1623. begin
  1624. if objsymend.objsection<>ObjData.CurrObjSec then
  1625. Internalerror(2019092801);
  1626. Tai_const(hp).value:=objsymend.address-ObjData.CurrObjSec.Size+Tai_const(hp).symofs;
  1627. end
  1628. else if objsymend.objsection<>objsym.objsection then
  1629. begin
  1630. if (Tai_const(hp).consttype in [aitconst_uleb128bit,aitconst_sleb128bit]) or
  1631. (objsym.objsection<>ObjData.CurrObjSec) then
  1632. internalerror(200905042);
  1633. end
  1634. {$push} {$R-}{$Q-}
  1635. else
  1636. Tai_const(hp).value:=objsymend.address-objsym.address+Tai_const(hp).symofs;
  1637. end;
  1638. {$pop}
  1639. if (Tai_const(hp).consttype in [aitconst_uleb128bit,aitconst_sleb128bit]) then
  1640. Tai_const(hp).fixsize;
  1641. ObjData.alloc(tai_const(hp).size);
  1642. end;
  1643. ait_section:
  1644. begin
  1645. { use cached value }
  1646. ObjData.setsection(Tai_section(hp).sec);
  1647. end;
  1648. ait_stab :
  1649. begin
  1650. if assigned(Tai_stab(hp).str) then
  1651. WriteStab(Tai_stab(hp).str);
  1652. end;
  1653. ait_symbol :
  1654. ObjData.SymbolDefine(Tai_symbol(hp).sym);
  1655. ait_symbol_end :
  1656. begin
  1657. objsym:=ObjData.SymbolRef(Tai_symbol_end(hp).sym);
  1658. objsym.size:=ObjData.CurrObjSec.Size-objsym.offset;
  1659. end;
  1660. ait_label :
  1661. ObjData.SymbolDefine(Tai_label(hp).labsym);
  1662. ait_string :
  1663. ObjData.alloc(Tai_string(hp).len);
  1664. ait_instruction :
  1665. ObjData.alloc(Taicpu(hp).Pass1(ObjData));
  1666. ait_cutobject :
  1667. if SmartAsm then
  1668. break;
  1669. ait_directive :
  1670. begin
  1671. case tai_directive(hp).directive of
  1672. asd_indirect_symbol:
  1673. if tai_directive(hp).name='' then
  1674. Internalerror(2009101103)
  1675. else if not SetIndirectToSymbol(Tai(hp.Previous), tai_directive(hp).name) then
  1676. Internalerror(2009101102);
  1677. asd_lazy_reference:
  1678. { handled in TreePass0 }
  1679. ;
  1680. asd_reference:
  1681. { ignore for now, but should be added}
  1682. ;
  1683. asd_thumb_func:
  1684. { ignore for now, but should be added}
  1685. ;
  1686. asd_code:
  1687. { ignore for now, but should be added}
  1688. ;
  1689. asd_option:
  1690. { ignore for now, but should be added}
  1691. ;
  1692. {$ifdef OMFOBJSUPPORT}
  1693. asd_omf_linnum_line:
  1694. { ignore for now, but should be added}
  1695. ;
  1696. {$endif OMFOBJSUPPORT}
  1697. asd_cpu:
  1698. begin
  1699. ObjData.CPUType:=cpu_none;
  1700. for cpu:=low(tcputype) to high(tcputype) do
  1701. if cputypestr[cpu]=tai_directive(hp).name then
  1702. begin
  1703. ObjData.CPUType:=cpu;
  1704. break;
  1705. end;
  1706. end;
  1707. else
  1708. internalerror(2010011102);
  1709. end;
  1710. end;
  1711. ait_eabi_attribute :
  1712. begin
  1713. eabi_section:=ObjData.findsection('.ARM.attributes');
  1714. if not(assigned(eabi_section)) then
  1715. Internalerror(2019100702);
  1716. if eabi_section.Size=0 then
  1717. eabi_section.alloc(16);
  1718. eabi_section.alloc(LengthUleb128(tai_eabi_attribute(hp).tag));
  1719. case tai_eabi_attribute(hp).eattr_typ of
  1720. eattrtype_dword:
  1721. eabi_section.alloc(LengthUleb128(tai_eabi_attribute(hp).value));
  1722. eattrtype_ntbs:
  1723. eabi_section.alloc(Length(tai_eabi_attribute(hp).valuestr^)+1);
  1724. else
  1725. Internalerror(2019100703);
  1726. end;
  1727. end;
  1728. else
  1729. ;
  1730. end;
  1731. hp:=Tai(hp.next);
  1732. end;
  1733. TreePass1:=hp;
  1734. end;
  1735. function TInternalAssembler.TreePass2(hp:Tai):Tai;
  1736. var
  1737. fillbuffer : tfillbuffer;
  1738. leblen : byte;
  1739. lebbuf : array[0..63] of byte;
  1740. objsym,
  1741. ref,
  1742. objsymend : TObjSymbol;
  1743. zerobuf : array[0..63] of byte;
  1744. relative_reloc: boolean;
  1745. pdata : pointer;
  1746. ssingle : single;
  1747. ddouble : double;
  1748. {$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)}
  1749. eextended : extended;
  1750. {$else}
  1751. {$ifdef FPC_SOFT_FPUX80}
  1752. eextended : floatx80;
  1753. {$endif}
  1754. {$endif}
  1755. ccomp : comp;
  1756. tmp : word;
  1757. cpu: tcputype;
  1758. ddword : dword;
  1759. eabi_section: TObjSection;
  1760. s: String;
  1761. TmpDataPos: TObjSectionOfs;
  1762. begin
  1763. fillchar(zerobuf,sizeof(zerobuf),0);
  1764. fillchar(objsym,sizeof(objsym),0);
  1765. fillchar(objsymend,sizeof(objsymend),0);
  1766. { main loop }
  1767. while assigned(hp) do
  1768. begin
  1769. case hp.typ of
  1770. ait_align :
  1771. begin
  1772. if tai_align_abstract(hp).aligntype>ObjData.CurrObjSec.secalign then
  1773. InternalError(2012072301);
  1774. if oso_data in ObjData.CurrObjSec.secoptions then
  1775. ObjData.writebytes(Tai_align_abstract(hp).calculatefillbuf(fillbuffer,oso_executable in ObjData.CurrObjSec.secoptions)^,
  1776. Tai_align_abstract(hp).fillsize)
  1777. else
  1778. ObjData.alloc(Tai_align_abstract(hp).fillsize);
  1779. end;
  1780. ait_section :
  1781. begin
  1782. { use cached value }
  1783. ObjData.setsection(Tai_section(hp).sec);
  1784. end;
  1785. ait_symbol :
  1786. begin
  1787. ObjOutput.exportsymbol(ObjData.SymbolRef(Tai_symbol(hp).sym));
  1788. end;
  1789. ait_symbol_end :
  1790. begin
  1791. { recalculate size, as some preceding instructions
  1792. could have been changed to smaller size }
  1793. objsym:=ObjData.SymbolRef(Tai_symbol_end(hp).sym);
  1794. objsym.size:=ObjData.CurrObjSec.Size-objsym.offset;
  1795. end;
  1796. ait_datablock :
  1797. begin
  1798. ObjOutput.exportsymbol(ObjData.SymbolRef(Tai_datablock(hp).sym));
  1799. {$ifdef USE_COMM_IN_BSS}
  1800. if not(writingpackages and
  1801. Tai_datablock(hp).is_global) then
  1802. {$endif USE_COMM_IN_BSS}
  1803. begin
  1804. ObjData.allocalign(used_align(size_2_align(Tai_datablock(hp).size),0,ObjData.CurrObjSec.secalign));
  1805. ObjData.alloc(Tai_datablock(hp).size);
  1806. end;
  1807. end;
  1808. ait_realconst:
  1809. begin
  1810. case tai_realconst(hp).realtyp of
  1811. aitrealconst_s32bit:
  1812. begin
  1813. ssingle:=single(tai_realconst(hp).value.s32val);
  1814. pdata:=@ssingle;
  1815. end;
  1816. aitrealconst_s64bit:
  1817. begin
  1818. ddouble:=double(tai_realconst(hp).value.s64val);
  1819. pdata:=@ddouble;
  1820. end;
  1821. {$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)}
  1822. { can't write full 80 bit floating point constants yet on non-x86 }
  1823. aitrealconst_s80bit:
  1824. begin
  1825. eextended:=extended(tai_realconst(hp).value.s80val);
  1826. pdata:=@eextended;
  1827. end;
  1828. {$else}
  1829. {$ifdef FPC_SOFT_FPUX80}
  1830. {$push}{$warn 6018 off} { Unreachable code due to compile time evaluation }
  1831. aitrealconst_s80bit:
  1832. begin
  1833. if sizeof(tai_realconst(hp).value.s80val) = sizeof(double) then
  1834. eextended:=float64_to_floatx80(float64(double(tai_realconst(hp).value.s80val)))
  1835. else if sizeof(tai_realconst(hp).value.s80val) = sizeof(single) then
  1836. eextended:=float32_to_floatx80(float32(single(tai_realconst(hp).value.s80val)))
  1837. else
  1838. internalerror(2017091901);
  1839. pdata:=@eextended;
  1840. end;
  1841. {$pop}
  1842. {$endif}
  1843. {$endif cpuextended}
  1844. aitrealconst_s64comp:
  1845. begin
  1846. ccomp:=comp(tai_realconst(hp).value.s64compval);
  1847. pdata:=@ccomp;
  1848. end;
  1849. else
  1850. internalerror(2015030501);
  1851. end;
  1852. ObjData.writebytes(pdata^,tai_realconst(hp).datasize);
  1853. ObjData.writebytes(zerobuf,tai_realconst(hp).savesize-tai_realconst(hp).datasize);
  1854. end;
  1855. ait_string :
  1856. ObjData.writebytes(Tai_string(hp).str^,Tai_string(hp).len);
  1857. ait_const :
  1858. begin
  1859. { Recalculate relative symbols, addresses of forward references
  1860. can be changed in treepass1 }
  1861. relative_reloc:=false;
  1862. if assigned(tai_const(hp).sym) and
  1863. assigned(tai_const(hp).endsym) then
  1864. begin
  1865. objsym:=Objdata.SymbolRef(tai_const(hp).sym);
  1866. objsymend:=Objdata.SymbolRef(tai_const(hp).endsym);
  1867. relative_reloc:=(objsym.objsection<>objsymend.objsection);
  1868. if Tai_const(hp).consttype in [aitconst_gottpoff] then
  1869. begin
  1870. if objsymend.objsection<>ObjData.CurrObjSec then
  1871. Internalerror(2019092802);
  1872. Tai_const(hp).value:=objsymend.address-ObjData.CurrObjSec.Size+Tai_const(hp).symofs;
  1873. end
  1874. else if Tai_const(hp).consttype in [aitconst_tlsgd,aitconst_tlsdesc] then
  1875. begin
  1876. if objsymend.objsection<>ObjData.CurrObjSec then
  1877. Internalerror(2019092802);
  1878. Tai_const(hp).value:=ObjData.CurrObjSec.Size-objsymend.address+Tai_const(hp).symofs;
  1879. end
  1880. else if objsymend.objsection<>objsym.objsection then
  1881. begin
  1882. if (Tai_const(hp).consttype in [aitconst_uleb128bit,aitconst_sleb128bit]) or
  1883. (objsym.objsection<>ObjData.CurrObjSec) then
  1884. internalerror(2019010301);
  1885. end
  1886. else
  1887. {$push} {$R-}{$Q-}
  1888. Tai_const(hp).value:=objsymend.address-objsym.address+Tai_const(hp).symofs;
  1889. end;
  1890. {$pop}
  1891. case tai_const(hp).consttype of
  1892. aitconst_64bit,
  1893. aitconst_32bit,
  1894. aitconst_16bit,
  1895. aitconst_64bit_unaligned,
  1896. aitconst_32bit_unaligned,
  1897. aitconst_16bit_unaligned,
  1898. aitconst_8bit :
  1899. begin
  1900. if assigned(tai_const(hp).sym) and
  1901. not assigned(tai_const(hp).endsym) then
  1902. ObjData.writereloc(Tai_const(hp).symofs,tai_const(hp).size,Objdata.SymbolRef(tai_const(hp).sym),RELOC_ABSOLUTE)
  1903. else if relative_reloc then
  1904. ObjData.writereloc(ObjData.CurrObjSec.size+tai_const(hp).size-objsym.address+tai_const(hp).symofs,tai_const(hp).size,objsymend,RELOC_RELATIVE)
  1905. else
  1906. ObjData.writebytes(Tai_const(hp).value,tai_const(hp).size);
  1907. end;
  1908. aitconst_rva_symbol :
  1909. begin
  1910. { PE32+? }
  1911. if target_info.system in systems_peoptplus then
  1912. ObjData.writereloc(Tai_const(hp).symofs,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_RVA)
  1913. else
  1914. ObjData.writereloc(Tai_const(hp).symofs,sizeof(pint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_RVA);
  1915. end;
  1916. aitconst_secrel32_symbol :
  1917. begin
  1918. { Required for DWARF2 support under Windows }
  1919. ObjData.writereloc(Tai_const(hp).symofs,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_SECREL32);
  1920. end;
  1921. {$ifdef i8086}
  1922. aitconst_farptr :
  1923. if assigned(tai_const(hp).sym) and
  1924. not assigned(tai_const(hp).endsym) then
  1925. ObjData.writereloc(Tai_const(hp).symofs,tai_const(hp).size,Objdata.SymbolRef(tai_const(hp).sym),RELOC_FARPTR)
  1926. else if relative_reloc then
  1927. internalerror(2015040601)
  1928. else
  1929. ObjData.writebytes(Tai_const(hp).value,tai_const(hp).size);
  1930. aitconst_seg:
  1931. if assigned(tai_const(hp).sym) and (tai_const(hp).size=2) then
  1932. ObjData.writereloc(0,2,Objdata.SymbolRef(tai_const(hp).sym),RELOC_SEG)
  1933. else
  1934. internalerror(2015110502);
  1935. aitconst_dgroup:
  1936. ObjData.writereloc(0,2,nil,RELOC_DGROUP);
  1937. aitconst_fardataseg:
  1938. ObjData.writereloc(0,2,nil,RELOC_FARDATASEG);
  1939. {$endif i8086}
  1940. {$ifdef arm}
  1941. aitconst_got:
  1942. ObjData.writereloc(Tai_const(hp).symofs,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_GOT32);
  1943. { aitconst_gottpoff:
  1944. ObjData.writereloc(Tai_const(hp).symofs,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_TPOFF); }
  1945. aitconst_tpoff:
  1946. ObjData.writereloc(Tai_const(hp).symofs,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_TPOFF);
  1947. aitconst_tlsgd:
  1948. ObjData.writereloc(Tai_const(hp).symofs,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_TLSGD);
  1949. aitconst_tlsdesc:
  1950. begin
  1951. { must be a relative symbol, thus value being valid }
  1952. if not(assigned(tai_const(hp).sym)) or not(assigned(tai_const(hp).endsym)) then
  1953. Internalerror(2019092904);
  1954. ObjData.writereloc(Tai_const(hp).value,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_TLSDESC);
  1955. end;
  1956. {$endif arm}
  1957. aitconst_dtpoff:
  1958. { so far, the size of dtpoff is fixed to 4 bytes }
  1959. ObjData.writereloc(Tai_const(hp).symofs,4,Objdata.SymbolRef(tai_const(hp).sym),RELOC_DTPOFF);
  1960. aitconst_gotoff_symbol:
  1961. ObjData.writereloc(Tai_const(hp).symofs,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_GOTOFF);
  1962. aitconst_uleb128bit,
  1963. aitconst_sleb128bit :
  1964. begin
  1965. if Tai_const(hp).fixed_size=0 then
  1966. Internalerror(2019030302);
  1967. if tai_const(hp).consttype=aitconst_uleb128bit then
  1968. leblen:=EncodeUleb128(qword(Tai_const(hp).value),lebbuf,Tai_const(hp).fixed_size)
  1969. else
  1970. leblen:=EncodeSleb128(Tai_const(hp).value,lebbuf,Tai_const(hp).fixed_size);
  1971. if leblen<>tai_const(hp).fixed_size then
  1972. internalerror(200709271);
  1973. ObjData.writebytes(lebbuf,leblen);
  1974. end;
  1975. aitconst_darwin_dwarf_delta32,
  1976. aitconst_darwin_dwarf_delta64:
  1977. ObjData.writebytes(Tai_const(hp).value,tai_const(hp).size);
  1978. aitconst_half16bit,
  1979. aitconst_gs:
  1980. begin
  1981. tmp:=Tai_const(hp).value div 2;
  1982. ObjData.writebytes(tmp,2);
  1983. end;
  1984. else
  1985. internalerror(200603254);
  1986. end;
  1987. end;
  1988. ait_label :
  1989. begin
  1990. { exporting shouldn't be necessary as labels are local,
  1991. but it's better to be on the safe side (PFV) }
  1992. ObjOutput.exportsymbol(ObjData.SymbolRef(Tai_label(hp).labsym));
  1993. end;
  1994. ait_instruction :
  1995. Taicpu(hp).Pass2(ObjData);
  1996. ait_stab :
  1997. WriteStab(Tai_stab(hp).str);
  1998. ait_function_name,
  1999. ait_force_line : ;
  2000. ait_cutobject :
  2001. if SmartAsm then
  2002. break;
  2003. ait_directive :
  2004. begin
  2005. case tai_directive(hp).directive of
  2006. asd_weak_definition,
  2007. asd_weak_reference:
  2008. begin
  2009. objsym:=ObjData.symbolref(tai_directive(hp).name);
  2010. if objsym.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL] then
  2011. objsym.bind:=AB_WEAK_EXTERNAL
  2012. else
  2013. { TODO: should become a weak definition; for now, do
  2014. the same as what was done for ait_weak }
  2015. objsym.bind:=AB_WEAK_EXTERNAL;
  2016. end;
  2017. asd_cpu:
  2018. begin
  2019. ObjData.CPUType:=cpu_none;
  2020. for cpu:=low(tcputype) to high(tcputype) do
  2021. if cputypestr[cpu]=tai_directive(hp).name then
  2022. begin
  2023. ObjData.CPUType:=cpu;
  2024. break;
  2025. end;
  2026. end;
  2027. {$ifdef OMFOBJSUPPORT}
  2028. asd_omf_linnum_line:
  2029. begin
  2030. TOmfObjSection(ObjData.CurrObjSec).LinNumEntries.Add(
  2031. TOmfSubRecord_LINNUM_MsLink_Entry.Create(
  2032. strtoint(tai_directive(hp).name),
  2033. ObjData.CurrObjSec.Size
  2034. ));
  2035. end;
  2036. {$endif OMFOBJSUPPORT}
  2037. else
  2038. ;
  2039. end
  2040. end;
  2041. ait_symbolpair:
  2042. begin
  2043. if tai_symbolpair(hp).kind=spk_set then
  2044. begin
  2045. objsym:=ObjData.symbolref(tai_symbolpair(hp).sym^);
  2046. ref:=objdata.symbolref(tai_symbolpair(hp).value^);
  2047. objsym.offset:=ref.offset;
  2048. objsym.objsection:=ref.objsection;
  2049. {$ifdef arm}
  2050. objsym.ThumbFunc:=ref.ThumbFunc;
  2051. {$endif arm}
  2052. end;
  2053. end;
  2054. {$ifndef DISABLE_WIN64_SEH}
  2055. ait_seh_directive :
  2056. tai_seh_directive(hp).generate_code(objdata);
  2057. {$endif DISABLE_WIN64_SEH}
  2058. ait_eabi_attribute :
  2059. begin
  2060. eabi_section:=ObjData.findsection('.ARM.attributes');
  2061. if not(assigned(eabi_section)) then
  2062. Internalerror(2019100704);
  2063. if eabi_section.Size=0 then
  2064. begin
  2065. s:='A';
  2066. eabi_section.write(s[1],1);
  2067. ddword:=eabi_section.Size-1;
  2068. eabi_section.write(ddword,4);
  2069. s:='aeabi'#0;
  2070. eabi_section.write(s[1],6);
  2071. s:=#1;
  2072. eabi_section.write(s[1],1);
  2073. ddword:=eabi_section.Size-1-4-6-1;
  2074. eabi_section.write(ddword,4);
  2075. end;
  2076. leblen:=EncodeUleb128(tai_eabi_attribute(hp).tag,lebbuf,0);
  2077. eabi_section.write(lebbuf,leblen);
  2078. case tai_eabi_attribute(hp).eattr_typ of
  2079. eattrtype_dword:
  2080. begin
  2081. leblen:=EncodeUleb128(tai_eabi_attribute(hp).value,lebbuf,0);
  2082. eabi_section.write(lebbuf,leblen);
  2083. end;
  2084. eattrtype_ntbs:
  2085. begin
  2086. s:=tai_eabi_attribute(hp).valuestr^+#0;
  2087. eabi_section.write(s[1],Length(s));
  2088. end
  2089. else
  2090. Internalerror(2019100705);
  2091. end;
  2092. { update size of attributes section, write directly to the dyn. arrays as
  2093. we do not increase the size of section }
  2094. TmpDataPos:=eabi_section.Data.Pos;
  2095. eabi_section.Data.seek(1);
  2096. ddword:=eabi_section.Size-1;
  2097. eabi_section.Data.write(ddword,4);
  2098. eabi_section.Data.seek(12);
  2099. ddword:=eabi_section.Size-1-4-6;
  2100. eabi_section.Data.write(ddword,4);
  2101. eabi_section.Data.Seek(TmpDataPos);
  2102. end;
  2103. else
  2104. ;
  2105. end;
  2106. hp:=Tai(hp.next);
  2107. end;
  2108. TreePass2:=hp;
  2109. end;
  2110. procedure TInternalAssembler.writetree;
  2111. label
  2112. doexit;
  2113. var
  2114. hp : Tai;
  2115. ObjWriter : TObjectWriter;
  2116. begin
  2117. ObjWriter:=TObjectwriter.create;
  2118. ObjOutput:=CObjOutput.Create(ObjWriter);
  2119. ObjData:=ObjOutput.newObjData(ObjFileName);
  2120. { Pass 0 }
  2121. ObjData.currpass:=0;
  2122. ObjData.createsection(sec_code);
  2123. ObjData.beforealloc;
  2124. { start with list 1 }
  2125. currlistidx:=1;
  2126. currlist:=list[currlistidx];
  2127. hp:=Tai(currList.first);
  2128. while assigned(hp) do
  2129. begin
  2130. hp:=TreePass0(hp);
  2131. MaybeNextList(hp);
  2132. end;
  2133. ObjData.afteralloc;
  2134. { leave if errors have occurred }
  2135. if errorcount>0 then
  2136. goto doexit;
  2137. { Pass 1 }
  2138. ObjData.currpass:=1;
  2139. ObjData.resetsections;
  2140. ObjData.beforealloc;
  2141. ObjData.createsection(sec_code);
  2142. { start with list 1 }
  2143. currlistidx:=1;
  2144. currlist:=list[currlistidx];
  2145. hp:=Tai(currList.first);
  2146. while assigned(hp) do
  2147. begin
  2148. hp:=TreePass1(hp);
  2149. MaybeNextList(hp);
  2150. end;
  2151. ObjData.createsection(sec_code);
  2152. ObjData.afteralloc;
  2153. { leave if errors have occurred }
  2154. if errorcount>0 then
  2155. goto doexit;
  2156. { Pass 2 }
  2157. ObjData.currpass:=2;
  2158. ObjData.resetsections;
  2159. ObjData.beforewrite;
  2160. ObjData.createsection(sec_code);
  2161. { start with list 1 }
  2162. currlistidx:=1;
  2163. currlist:=list[currlistidx];
  2164. hp:=Tai(currList.first);
  2165. while assigned(hp) do
  2166. begin
  2167. hp:=TreePass2(hp);
  2168. MaybeNextList(hp);
  2169. end;
  2170. ObjData.createsection(sec_code);
  2171. ObjData.afterwrite;
  2172. { don't write the .o file if errors have occurred }
  2173. if errorcount=0 then
  2174. begin
  2175. { write objectfile }
  2176. ObjOutput.startobjectfile(ObjFileName);
  2177. ObjOutput.writeobjectfile(ObjData);
  2178. end;
  2179. doexit:
  2180. { Cleanup }
  2181. ObjData.free;
  2182. ObjData:=nil;
  2183. ObjWriter.free;
  2184. end;
  2185. procedure TInternalAssembler.writetreesmart;
  2186. var
  2187. hp : Tai;
  2188. startsectype : TAsmSectiontype;
  2189. place: tcutplace;
  2190. ObjWriter : TObjectWriter;
  2191. startsecname: String;
  2192. startsecorder: TAsmSectionOrder;
  2193. begin
  2194. if not(cs_asm_leave in current_settings.globalswitches) and
  2195. not(af_needar in asminfo^.flags) then
  2196. ObjWriter:=CInternalAr.CreateAr(current_module.staticlibfilename)
  2197. else
  2198. ObjWriter:=TObjectwriter.create;
  2199. NextSmartName(cut_normal);
  2200. ObjOutput:=CObjOutput.Create(ObjWriter);
  2201. startsectype:=sec_none;
  2202. startsecname:='';
  2203. startsecorder:=secorder_default;
  2204. { start with list 1 }
  2205. currlistidx:=1;
  2206. currlist:=list[currlistidx];
  2207. hp:=Tai(currList.first);
  2208. while assigned(hp) do
  2209. begin
  2210. ObjData:=ObjOutput.newObjData(ObjFileName);
  2211. { Pass 0 }
  2212. ObjData.currpass:=0;
  2213. ObjData.resetsections;
  2214. ObjData.beforealloc;
  2215. if startsectype<>sec_none then
  2216. ObjData.CreateSection(startsectype,startsecname,startsecorder);
  2217. TreePass0(hp);
  2218. ObjData.afteralloc;
  2219. { leave if errors have occurred }
  2220. if errorcount>0 then
  2221. break;
  2222. { Pass 1 }
  2223. ObjData.currpass:=1;
  2224. ObjData.resetsections;
  2225. ObjData.beforealloc;
  2226. if startsectype<>sec_none then
  2227. ObjData.CreateSection(startsectype,startsecname,startsecorder);
  2228. TreePass1(hp);
  2229. ObjData.afteralloc;
  2230. { leave if errors have occurred }
  2231. if errorcount>0 then
  2232. break;
  2233. { Pass 2 }
  2234. ObjData.currpass:=2;
  2235. ObjOutput.startobjectfile(ObjFileName);
  2236. ObjData.resetsections;
  2237. ObjData.beforewrite;
  2238. if startsectype<>sec_none then
  2239. ObjData.CreateSection(startsectype,startsecname,startsecorder);
  2240. hp:=TreePass2(hp);
  2241. ObjData.afterwrite;
  2242. { leave if errors have occurred }
  2243. if errorcount>0 then
  2244. break;
  2245. { write the current objectfile }
  2246. ObjOutput.writeobjectfile(ObjData);
  2247. ObjData.free;
  2248. ObjData:=nil;
  2249. { end of lists? }
  2250. if not MaybeNextList(hp) then
  2251. break;
  2252. { we will start a new objectfile so reset everything }
  2253. { The place can still change in the next while loop, so don't init }
  2254. { the writer yet (JM) }
  2255. if (hp.typ=ait_cutobject) then
  2256. place := Tai_cutobject(hp).place
  2257. else
  2258. place := cut_normal;
  2259. { avoid empty files }
  2260. startsectype:=sec_none;
  2261. startsecname:='';
  2262. startsecorder:=secorder_default;
  2263. while assigned(hp) and
  2264. (Tai(hp).typ in [ait_marker,ait_comment,ait_section,ait_cutobject]) do
  2265. begin
  2266. if Tai(hp).typ=ait_section then
  2267. begin
  2268. startsectype:=Tai_section(hp).sectype;
  2269. startsecname:=Tai_section(hp).name^;
  2270. startsecorder:=Tai_section(hp).secorder;
  2271. end;
  2272. if (Tai(hp).typ=ait_cutobject) then
  2273. place:=Tai_cutobject(hp).place;
  2274. hp:=Tai(hp.next);
  2275. end;
  2276. if not MaybeNextList(hp) then
  2277. break;
  2278. { start next objectfile }
  2279. NextSmartName(place);
  2280. end;
  2281. ObjData.free;
  2282. ObjData:=nil;
  2283. ObjWriter.free;
  2284. end;
  2285. procedure TInternalAssembler.MakeObject;
  2286. var to_do:set of TasmlistType;
  2287. i:TasmlistType;
  2288. procedure addlist(p:TAsmList);
  2289. begin
  2290. inc(lists);
  2291. list[lists]:=p;
  2292. end;
  2293. begin
  2294. to_do:=[low(Tasmlisttype)..high(Tasmlisttype)];
  2295. if usedeffileforexports then
  2296. exclude(to_do,al_exports);
  2297. if not(tf_section_threadvars in target_info.flags) then
  2298. exclude(to_do,al_threadvars);
  2299. for i:=low(TasmlistType) to high(TasmlistType) do
  2300. if (i in to_do) and (current_asmdata.asmlists[i]<>nil) and
  2301. (not current_asmdata.asmlists[i].empty) then
  2302. addlist(current_asmdata.asmlists[i]);
  2303. if SmartAsm then
  2304. writetreesmart
  2305. else
  2306. writetree;
  2307. end;
  2308. {*****************************************************************************
  2309. Generate Assembler Files Main Procedure
  2310. *****************************************************************************}
  2311. Procedure GenerateAsm(smart:boolean);
  2312. var
  2313. a : TAssembler;
  2314. begin
  2315. if not assigned(CAssembler[target_asm.id]) then
  2316. Message(asmw_f_assembler_output_not_supported);
  2317. a:=CAssembler[target_asm.id].Create(@target_asm,smart);
  2318. a.MakeObject;
  2319. a.Free;
  2320. end;
  2321. function GetExternalGnuAssemblerWithAsmInfoWriter(info: pasminfo; wr: TExternalAssemblerOutputFile): TExternalAssembler;
  2322. var
  2323. asmkind: tasm;
  2324. begin
  2325. for asmkind in [as_gas,as_ggas,as_darwin] do
  2326. if assigned(asminfos[asmkind]) and
  2327. (target_info.system in asminfos[asmkind]^.supported_targets) then
  2328. begin
  2329. result:=TExternalAssemblerClass(CAssembler[asmkind]).CreateWithWriter(asminfos[asmkind],wr,false,false);
  2330. exit;
  2331. end;
  2332. Internalerror(2015090604);
  2333. end;
  2334. {*****************************************************************************
  2335. Init/Done
  2336. *****************************************************************************}
  2337. procedure RegisterAssembler(const r:tasminfo;c:TAssemblerClass);
  2338. var
  2339. t : tasm;
  2340. begin
  2341. t:=r.id;
  2342. if assigned(asminfos[t]) then
  2343. writeln('Warning: Assembler is already registered!')
  2344. else
  2345. Getmem(asminfos[t],sizeof(tasminfo));
  2346. asminfos[t]^:=r;
  2347. CAssembler[t]:=c;
  2348. end;
  2349. end.