2
0

assemble.pas 81 KB

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