assemble.pas 74 KB

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