assemble.pas 88 KB

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