assemble.pas 92 KB

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