agppcmpw.pas 40 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301
  1. {
  2. Copyright (c) 2002 by Florian Klaempfl
  3. This unit implements an asmoutput class for PowerPC with MPW syntax
  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. {
  18. This unit implements an asmoutput class for PowerPC with MPW syntax
  19. }
  20. unit agppcmpw;
  21. {$i fpcdefs.inc}
  22. interface
  23. uses
  24. aasmtai,
  25. globals,aasmbase,aasmcpu,assemble,
  26. cpubase;
  27. type
  28. TPPCMPWAssembler = class(TExternalAssembler)
  29. procedure WriteTree(p:TAAsmoutput);override;
  30. procedure WriteAsmList;override;
  31. Function DoAssemble:boolean;override;
  32. procedure WriteExternals;
  33. procedure WriteAsmFileHeader;
  34. private
  35. procedure WriteInstruction(hp : tai);
  36. procedure WriteProcedureHeader(var hp:tai);
  37. procedure WriteDataHeader(var s:string; isExported, isConst:boolean);
  38. cur_CSECT_name: String;
  39. cur_CSECT_class: String;
  40. end;
  41. implementation
  42. uses
  43. cutils,globtype,systems,cclasses,
  44. verbose,finput,fmodule,script,cpuinfo,
  45. cgbase,cgutils,
  46. itcpugas
  47. ;
  48. const
  49. line_length = 70;
  50. {Whether internal procedure references should be xxx[PR]: }
  51. use_PR = false;
  52. const_storage_class = '';
  53. var_storage_class = '';
  54. secnames : array[TAsmSectiontype] of string[10] = (
  55. '', {none}
  56. 'csect', {code}
  57. 'csect', {data}
  58. 'csect', {read only data}
  59. 'csect', {bss} 'csect',
  60. 'csect','csect','csect','csect','','','','','','','','','','','','','',''
  61. );
  62. type
  63. t64bitarray = array[0..7] of byte;
  64. t32bitarray = array[0..3] of byte;
  65. function ReplaceForbiddenChars(var s: string):Boolean;
  66. {Returns wheater a replacement has occured.}
  67. var
  68. i:Integer;
  69. {The dollar sign is not allowed in MPW PPCAsm}
  70. begin
  71. ReplaceForbiddenChars:=false;
  72. for i:=1 to Length(s) do
  73. if s[i]='$' then
  74. begin
  75. s[i]:='s';
  76. ReplaceForbiddenChars:=true;
  77. end;
  78. end;
  79. {*** From here is copyed from agppcgas.pp, except where marked with CHANGED.
  80. Perhaps put in a third common file. ***}
  81. function getreferencestring(var ref : treference) : string;
  82. var
  83. s : string;
  84. begin
  85. with ref do
  86. begin
  87. if (refaddr <> addr_no) then
  88. InternalError(2002110301)
  89. else if ((offset < -32768) or (offset > 32767)) then
  90. InternalError(19991);
  91. if assigned(symbol) then
  92. begin
  93. s:= symbol.name;
  94. ReplaceForbiddenChars(s);
  95. {if symbol.typ = AT_FUNCTION then
  96. ;}
  97. s:= s+'[TC]' {ref to TOC entry }
  98. end
  99. else
  100. s:= '';
  101. if offset<0 then
  102. s:=s+tostr(offset)
  103. else
  104. if (offset>0) then
  105. begin
  106. if assigned(symbol) then
  107. s:=s+'+'+tostr(offset)
  108. else
  109. s:=s+tostr(offset);
  110. end;
  111. if (index=NR_NO) and (base<>NR_NO) then
  112. begin
  113. if offset=0 then
  114. if not assigned(symbol) then
  115. s:=s+'0';
  116. s:=s+'('+gas_regname(base)+')';
  117. end
  118. else if (index<>NR_NO) and (base<>NR_NO) and (offset=0) then
  119. begin
  120. if (offset=0) then
  121. s:=s+gas_regname(base)+','+gas_regname(index)
  122. else
  123. internalerror(19992);
  124. end
  125. else if (base=NR_NO) and (offset=0) then
  126. begin
  127. {Temporary fix for inline asm, where a local var is referenced.}
  128. //if assigned(symbol) then
  129. // s:= s+'(rtoc)';
  130. end;
  131. end;
  132. getreferencestring:=s;
  133. end;
  134. function getopstr_jmp(const o:toper) : string;
  135. var
  136. hs : string;
  137. begin
  138. case o.typ of
  139. top_reg :
  140. getopstr_jmp:=gas_regname(o.reg);
  141. { no top_ref jumping for powerpc }
  142. top_const :
  143. getopstr_jmp:=tostr(o.val);
  144. top_ref :
  145. begin
  146. if o.ref^.refaddr=addr_full then
  147. begin
  148. hs:=o.ref^.symbol.name;
  149. ReplaceForbiddenChars(hs);
  150. case o.ref^.symbol.typ of
  151. AT_FUNCTION:
  152. begin
  153. if hs[1] <> '@' then {if not local label}
  154. if use_PR then
  155. hs:= '.'+hs+'[PR]'
  156. else
  157. hs:= '.'+hs
  158. end
  159. else
  160. ;
  161. end;
  162. if o.ref^.offset>0 then
  163. hs:=hs+'+'+tostr(o.ref^.offset)
  164. else
  165. if o.ref^.offset<0 then
  166. hs:=hs+tostr(o.ref^.offset);
  167. getopstr_jmp:=hs;
  168. end
  169. else
  170. internalerror(200402263);
  171. end;
  172. top_none:
  173. getopstr_jmp:='';
  174. else
  175. internalerror(2002070603);
  176. end;
  177. end;
  178. function getopstr(const o:toper) : string;
  179. var
  180. hs : string;
  181. begin
  182. case o.typ of
  183. top_reg:
  184. getopstr:=gas_regname(o.reg);
  185. top_const:
  186. getopstr:=tostr(longint(o.val));
  187. top_ref:
  188. if o.ref^.refaddr=addr_no then
  189. getopstr:=getreferencestring(o.ref^)
  190. else
  191. begin
  192. hs:=o.ref^.symbol.name;
  193. ReplaceForbiddenChars(hs);
  194. if o.ref^.offset>0 then
  195. hs:=hs+'+'+tostr(o.ref^.offset)
  196. else
  197. if o.ref^.offset<0 then
  198. hs:=hs+tostr(o.ref^.offset);
  199. getopstr:=hs;
  200. end;
  201. else
  202. internalerror(2002070604);
  203. end;
  204. end;
  205. function branchmode(o: tasmop): string[4];
  206. var tempstr: string[4];
  207. begin
  208. tempstr := '';
  209. case o of
  210. A_BCCTR,A_BCCTRL: tempstr := 'ctr';
  211. A_BCLR,A_BCLRL: tempstr := 'lr';
  212. end;
  213. case o of
  214. A_BL,A_BLA,A_BCL,A_BCLA,A_BCCTRL,A_BCLRL: tempstr := tempstr+'l';
  215. end;
  216. case o of
  217. A_BA,A_BLA,A_BCA,A_BCLA: tempstr:=tempstr+'a';
  218. end;
  219. branchmode := tempstr;
  220. end;
  221. function cond2str(op: tasmop; c: tasmcond): string;
  222. { note: no checking is performed whether the given combination of }
  223. { conditions is valid }
  224. var
  225. tempstr: string;
  226. begin
  227. tempstr:=#9;
  228. case c.simple of
  229. false:
  230. begin
  231. cond2str := tempstr+gas_op2str[op];
  232. case c.dirhint of
  233. DH_None:;
  234. DH_Minus:
  235. cond2str:=cond2str+'-';
  236. DH_Plus:
  237. cond2str:=cond2str+'+';
  238. else
  239. internalerror(2003112901);
  240. end;
  241. cond2str:=cond2str+#9+tostr(c.bo)+','+tostr(c.bi)+',';
  242. end;
  243. true:
  244. if (op >= A_B) and (op <= A_BCLRL) then
  245. case c.cond of
  246. { unconditional branch }
  247. C_NONE:
  248. cond2str := tempstr+gas_op2str[op];
  249. { bdnzt etc }
  250. else
  251. begin
  252. tempstr := tempstr+'b'+asmcondflag2str[c.cond]+
  253. branchmode(op);
  254. case c.dirhint of
  255. DH_None:
  256. tempstr:=tempstr+#9;
  257. DH_Minus:
  258. tempstr:=tempstr+('-'+#9);
  259. DH_Plus:
  260. tempstr:=tempstr+('+'+#9);
  261. else
  262. internalerror(2003112901);
  263. end;
  264. case c.cond of
  265. C_LT..C_NU:
  266. cond2str := tempstr+gas_regname(newreg(R_SPECIALREGISTER,c.cr,R_SUBWHOLE));
  267. C_T,C_F,C_DNZT,C_DNZF,C_DZT,C_DZF:
  268. cond2str := tempstr+tostr(c.crbit);
  269. else
  270. cond2str := tempstr;
  271. end;
  272. end;
  273. end
  274. { we have a trap instruction }
  275. else
  276. begin
  277. internalerror(2002070601);
  278. { not yet implemented !!!!!!!!!!!!!!!!!!!!! }
  279. { case tempstr := 'tw';}
  280. end;
  281. end;
  282. end;
  283. procedure TPPCMPWAssembler.WriteInstruction(hp : tai);
  284. var op: TAsmOp;
  285. s: string;
  286. i: byte;
  287. sep: string[3];
  288. begin
  289. op:=taicpu(hp).opcode;
  290. if is_calljmp(op) then
  291. begin
  292. { direct BO/BI in op[0] and op[1] not supported, put them in condition! }
  293. case op of
  294. A_B,A_BA:
  295. s:=#9+gas_op2str[op]+#9;
  296. A_BCTR,A_BCTRL,A_BLR,A_BLRL:
  297. s:=#9+gas_op2str[op];
  298. A_BL,A_BLA:
  299. s:=#9+gas_op2str[op]+#9;
  300. else
  301. begin
  302. s:=cond2str(op,taicpu(hp).condition);
  303. if (s[length(s)] <> #9) and
  304. (taicpu(hp).ops>0) then
  305. s := s + ',';
  306. end;
  307. end;
  308. if (taicpu(hp).ops>0) and (taicpu(hp).oper[0]^.typ<>top_none) then
  309. begin
  310. { first write the current contents of s, because the symbol }
  311. { may be 255 characters }
  312. asmwrite(s);
  313. s:=getopstr_jmp(taicpu(hp).oper[0]^);
  314. end;
  315. end
  316. else
  317. { process operands }
  318. begin
  319. s:=#9+gas_op2str[op];
  320. if taicpu(hp).ops<>0 then
  321. begin
  322. sep:=#9;
  323. for i:=0 to taicpu(hp).ops-1 do
  324. begin
  325. s:=s+sep+getopstr(taicpu(hp).oper[i]^);
  326. sep:=',';
  327. end;
  328. end;
  329. end;
  330. AsmWriteLn(s);
  331. end;
  332. {*** Until here is copyed from agppcgas.pp. ***}
  333. function single2str(d : single) : string;
  334. var
  335. hs : string;
  336. p : byte;
  337. begin
  338. str(d,hs);
  339. { nasm expects a lowercase e }
  340. p:=pos('E',hs);
  341. if p>0 then
  342. hs[p]:='e';
  343. p:=pos('+',hs);
  344. if p>0 then
  345. delete(hs,p,1);
  346. single2str:=lower(hs);
  347. end;
  348. function double2str(d : double) : string;
  349. var
  350. hs : string;
  351. p : byte;
  352. begin
  353. str(d,hs);
  354. { nasm expects a lowercase e }
  355. p:=pos('E',hs);
  356. if p>0 then
  357. hs[p]:='e';
  358. p:=pos('+',hs);
  359. if p>0 then
  360. delete(hs,p,1);
  361. double2str:=lower(hs);
  362. end;
  363. { convert floating point values }
  364. { to correct endian }
  365. procedure swap64bitarray(var t: t64bitarray);
  366. var
  367. b: byte;
  368. begin
  369. b:= t[7];
  370. t[7] := t[0];
  371. t[0] := b;
  372. b := t[6];
  373. t[6] := t[1];
  374. t[1] := b;
  375. b:= t[5];
  376. t[5] := t[2];
  377. t[2] := b;
  378. b:= t[4];
  379. t[4] := t[3];
  380. t[3] := b;
  381. end;
  382. procedure swap32bitarray(var t: t32bitarray);
  383. var
  384. b: byte;
  385. begin
  386. b:= t[1];
  387. t[1]:= t[2];
  388. t[2]:= b;
  389. b:= t[0];
  390. t[0]:= t[3];
  391. t[3]:= b;
  392. end;
  393. function fixline(s:string):string;
  394. {
  395. return s with all leading and ending spaces and tabs removed
  396. }
  397. var
  398. i,j,k : longint;
  399. begin
  400. i:=length(s);
  401. while (i>0) and (s[i] in [#9,' ']) do
  402. dec(i);
  403. j:=1;
  404. while (j<i) and (s[j] in [#9,' ']) do
  405. inc(j);
  406. for k:=j to i do
  407. if s[k] in [#0..#31,#127..#255] then
  408. s[k]:='.';
  409. fixline:=Copy(s,j,i-j+1);
  410. end;
  411. Function PadTabs(const p:string;addch:char):string;
  412. var
  413. s : string;
  414. i : longint;
  415. begin
  416. i:=length(p);
  417. if addch<>#0 then
  418. begin
  419. inc(i);
  420. s:=p+addch;
  421. end
  422. else
  423. s:=p;
  424. if i<8 then
  425. PadTabs:=s+#9#9
  426. else
  427. PadTabs:=s+#9;
  428. end;
  429. {****************************************************************************
  430. PowerPC MPW Assembler
  431. ****************************************************************************}
  432. procedure TPPCMPWAssembler.WriteProcedureHeader(var hp:tai);
  433. {Returns the current hp where the caller should continue from}
  434. {For multiple entry procedures, only the last is exported as xxx[PR]
  435. (if use_PR is set) }
  436. procedure WriteExportHeader(hp:tai);
  437. var
  438. s: string;
  439. replaced: boolean;
  440. begin
  441. s:= tai_symbol(hp).sym.name;
  442. replaced:= ReplaceForbiddenChars(s);
  443. if not use_PR then
  444. begin
  445. AsmWrite(#9'export'#9'.');
  446. AsmWrite(s);
  447. if replaced then
  448. begin
  449. AsmWrite(' => ''.');
  450. AsmWrite(tai_symbol(hp).sym.name);
  451. AsmWrite('''');
  452. end;
  453. AsmLn;
  454. end;
  455. AsmWrite(#9'export'#9);
  456. AsmWrite(s);
  457. AsmWrite('[DS]');
  458. if replaced then
  459. begin
  460. AsmWrite(' => ''');
  461. AsmWrite(tai_symbol(hp).sym.name);
  462. AsmWrite('[DS]''');
  463. end;
  464. AsmLn;
  465. {Entry in transition vector: }
  466. AsmWrite(#9'csect'#9); AsmWrite(s); AsmWriteLn('[DS]');
  467. AsmWrite(#9'dc.l'#9'.'); AsmWriteLn(s);
  468. AsmWriteln(#9'dc.l'#9'TOC[tc0]');
  469. {Entry in TOC: }
  470. AsmWriteLn(#9'toc');
  471. AsmWrite(#9'tc'#9);
  472. AsmWrite(s); AsmWrite('[TC],');
  473. AsmWrite(s); AsmWriteln('[DS]');
  474. end;
  475. function GetAdjacentTaiSymbol(var hp:tai):Boolean;
  476. begin
  477. GetAdjacentTaiSymbol:= false;
  478. while assigned(hp.next) do
  479. case tai(hp.next).typ of
  480. ait_symbol:
  481. begin
  482. hp:=tai(hp.next);
  483. GetAdjacentTaiSymbol:= true;
  484. Break;
  485. end;
  486. ait_function_name:
  487. hp:=tai(hp.next);
  488. else
  489. begin
  490. //AsmWriteln(' ;#*#*# ' + tostr(Ord(tai(hp.next).typ)));
  491. Break;
  492. end;
  493. end;
  494. end;
  495. var
  496. first,last: tai;
  497. s: string;
  498. replaced: boolean;
  499. begin
  500. s:= tai_symbol(hp).sym.name;
  501. {Write all headers}
  502. first:= hp;
  503. repeat
  504. WriteExportHeader(hp);
  505. last:= hp;
  506. until not GetAdjacentTaiSymbol(hp);
  507. {Start the section of the body of the proc: }
  508. s:= tai_symbol(last).sym.name;
  509. replaced:= ReplaceForbiddenChars(s);
  510. if use_PR then
  511. begin
  512. AsmWrite(#9'export'#9'.'); AsmWrite(s); AsmWrite('[PR]');
  513. if replaced then
  514. begin
  515. AsmWrite(' => ''.');
  516. AsmWrite(tai_symbol(last).sym.name);
  517. AsmWrite('[PR]''');
  518. end;
  519. AsmLn;
  520. end;
  521. {Starts the section: }
  522. AsmWrite(#9'csect'#9'.');
  523. AsmWrite(s);
  524. AsmWriteLn('[PR]');
  525. {Info for the debugger: }
  526. AsmWrite(#9'function'#9'.');
  527. AsmWrite(s);
  528. AsmWriteLn('[PR]');
  529. {Write all labels: }
  530. hp:= first;
  531. repeat
  532. s:= tai_symbol(hp).sym.name;
  533. ReplaceForbiddenChars(s);
  534. AsmWrite('.'); AsmWrite(s); AsmWriteLn(':');
  535. until not GetAdjacentTaiSymbol(hp);
  536. end;
  537. procedure TPPCMPWAssembler.WriteDataHeader(var s:string; isExported, isConst:boolean);
  538. // Returns in s the changed string
  539. var
  540. sym: string;
  541. replaced: boolean;
  542. begin
  543. sym:= s;
  544. replaced:= ReplaceForbiddenChars(s);
  545. if isExported then
  546. begin
  547. AsmWrite(#9'export'#9);
  548. AsmWrite(s);
  549. if isConst then
  550. AsmWrite(const_storage_class)
  551. else
  552. AsmWrite(var_storage_class);
  553. if replaced then
  554. begin
  555. AsmWrite(' => ''');
  556. AsmWrite(sym);
  557. AsmWrite('''');
  558. end;
  559. AsmLn;
  560. end;
  561. if not macos_direct_globals then
  562. begin
  563. {The actual section is here interrupted, by inserting a "tc" entry}
  564. AsmWriteLn(#9'toc');
  565. AsmWrite(#9'tc'#9);
  566. AsmWrite(s);
  567. AsmWrite('[TC], ');
  568. AsmWrite(s);
  569. if isConst then
  570. AsmWrite(const_storage_class)
  571. else
  572. AsmWrite(var_storage_class);
  573. AsmLn;
  574. {The interrupted section is here continued.}
  575. AsmWrite(#9'csect'#9);
  576. AsmWriteln(cur_CSECT_name+cur_CSECT_class);
  577. AsmWrite(PadTabs(s+':',#0));
  578. end
  579. else
  580. begin
  581. AsmWrite(#9'csect'#9);
  582. AsmWrite(s);
  583. AsmWrite('[TC]');
  584. end;
  585. AsmLn;
  586. end;
  587. var
  588. LasTSec : TAsmSectiontype;
  589. lastfileinfo : tfileposinfo;
  590. infile,
  591. lastinfile : tinputfile;
  592. const
  593. ait_const2str:array[aitconst_32bit..aitconst_8bit] of string[8]=
  594. (#9'dc.l'#9,#9'dc.w'#9,#9'dc.b'#9);
  595. procedure TPPCMPWAssembler.WriteTree(p:TAAsmoutput);
  596. var
  597. s,
  598. prefix,
  599. suffix : string;
  600. hp : tai;
  601. hp1 : tailineinfo;
  602. counter,
  603. lines,
  604. InlineLevel : longint;
  605. i,j,l : longint;
  606. consttype : taiconst_type;
  607. found,
  608. do_line,DoNotSplitLine,
  609. quoted : boolean;
  610. sep : char;
  611. replaced : boolean;
  612. sin : single;
  613. d : double;
  614. begin
  615. if not assigned(p) then
  616. exit;
  617. InlineLevel:=0;
  618. { lineinfo is only needed for al_procedures (PFV) }
  619. do_line:=((cs_asm_source in aktglobalswitches) or
  620. (cs_lineinfo in aktmoduleswitches))
  621. and (p=asmlist[al_procedures]);
  622. DoNotSplitLine:=false;
  623. hp:=tai(p.first);
  624. while assigned(hp) do
  625. begin
  626. if not(hp.typ in SkipLineInfo) and
  627. not DoNotSplitLine then
  628. begin
  629. hp1 := hp as tailineinfo;
  630. if do_line then
  631. begin
  632. { load infile }
  633. if lastfileinfo.fileindex<>hp1.fileinfo.fileindex then
  634. begin
  635. infile:=current_module.sourcefiles.get_file(hp1.fileinfo.fileindex);
  636. if assigned(infile) then
  637. begin
  638. { open only if needed !! }
  639. if (cs_asm_source in aktglobalswitches) then
  640. infile.open;
  641. end;
  642. { avoid unnecessary reopens of the same file !! }
  643. lastfileinfo.fileindex:=hp1.fileinfo.fileindex;
  644. { be sure to change line !! }
  645. lastfileinfo.line:=-1;
  646. end;
  647. { write source }
  648. if (cs_asm_source in aktglobalswitches) and
  649. assigned(infile) then
  650. begin
  651. if (infile<>lastinfile) then
  652. begin
  653. AsmWriteLn(target_asm.comment+'['+infile.name^+']');
  654. if assigned(lastinfile) then
  655. lastinfile.close;
  656. end;
  657. if (hp1.fileinfo.line<>lastfileinfo.line) and
  658. ((hp1.fileinfo.line<infile.maxlinebuf) or (InlineLevel>0)) then
  659. begin
  660. if (hp1.fileinfo.line<>0) and
  661. ((infile.linebuf^[hp1.fileinfo.line]>=0) or (InlineLevel>0)) then
  662. AsmWriteLn(target_asm.comment+'['+tostr(hp1.fileinfo.line)+'] '+
  663. fixline(infile.GetLineStr(hp1.fileinfo.line)));
  664. { set it to a negative value !
  665. to make that is has been read already !! PM }
  666. if (infile.linebuf^[hp1.fileinfo.line]>=0) then
  667. infile.linebuf^[hp1.fileinfo.line]:=-infile.linebuf^[hp1.fileinfo.line]-1;
  668. end;
  669. end;
  670. lastfileinfo:=hp1.fileinfo;
  671. lastinfile:=infile;
  672. end;
  673. end;
  674. DoNotSplitLine:=false;
  675. case hp.typ of
  676. ait_comment:
  677. begin
  678. AsmWrite(target_asm.comment);
  679. AsmWritePChar(tai_comment(hp).str);
  680. AsmLn;
  681. end;
  682. ait_regalloc,
  683. ait_tempalloc:
  684. ;
  685. ait_section:
  686. begin
  687. {if LasTSec<>sec_none then
  688. AsmWriteLn('_'+target_asm.secnames[LasTSec]+#9#9'ENDS');}
  689. if tai_section(hp).sectype<>sec_none then
  690. begin
  691. if tai_section(hp).sectype in [sec_data,sec_rodata,sec_bss] then
  692. cur_CSECT_class:= '[RW]'
  693. else if tai_section(hp).sectype in [sec_code] then
  694. cur_CSECT_class:= ''
  695. else
  696. cur_CSECT_class:= '[RO]';
  697. s:= tai_section(hp).name^;
  698. if s = '' then
  699. InternalError(2004101001); {Nameless sections should not occur on MPW}
  700. ReplaceForbiddenChars(s);
  701. cur_CSECT_name:= s;
  702. AsmLn;
  703. AsmWriteLn(#9+secnames[tai_section(hp).sectype]+' '+cur_CSECT_name+cur_CSECT_class);
  704. end;
  705. LasTSec:=tai_section(hp).sectype;
  706. end;
  707. ait_align:
  708. begin
  709. case tai_align(hp).aligntype of
  710. 1:AsmWriteLn(#9'align 0');
  711. 2:AsmWriteLn(#9'align 1');
  712. 4:AsmWriteLn(#9'align 2');
  713. otherwise internalerror(2002110302);
  714. end;
  715. end;
  716. ait_datablock: {Storage for global variables.}
  717. begin
  718. s:= tai_datablock(hp).sym.name;
  719. WriteDataHeader(s, tai_datablock(hp).is_global, false);
  720. if not macos_direct_globals then
  721. begin
  722. AsmWriteLn(#9'ds.b '+tostr(tai_datablock(hp).size));
  723. end
  724. else
  725. begin
  726. AsmWriteLn(PadTabs(s+':',#0)+'ds.b '+tostr(tai_datablock(hp).size));
  727. {TODO: ? PadTabs(s,#0) }
  728. end;
  729. end;
  730. ait_const:
  731. begin
  732. consttype:=tai_const(hp).consttype;
  733. case consttype of
  734. aitconst_128bit:
  735. begin
  736. internalerror(200404291);
  737. end;
  738. aitconst_64bit:
  739. begin
  740. if assigned(tai_const(hp).sym) then
  741. internalerror(200404292);
  742. AsmWrite(ait_const2str[aitconst_32bit]);
  743. if target_info.endian = endian_little then
  744. begin
  745. AsmWrite(tostr(longint(lo(tai_const(hp).value))));
  746. AsmWrite(',');
  747. AsmWrite(tostr(longint(hi(tai_const(hp).value))));
  748. end
  749. else
  750. begin
  751. AsmWrite(tostr(longint(hi(tai_const(hp).value))));
  752. AsmWrite(',');
  753. AsmWrite(tostr(longint(lo(tai_const(hp).value))));
  754. end;
  755. AsmLn;
  756. end;
  757. aitconst_uleb128bit,
  758. aitconst_sleb128bit,
  759. aitconst_32bit,
  760. aitconst_16bit,
  761. aitconst_8bit,
  762. aitconst_rva_symbol,
  763. aitconst_indirect_symbol :
  764. begin
  765. AsmWrite(ait_const2str[consttype]);
  766. l:=0;
  767. repeat
  768. if assigned(tai_const(hp).sym) then
  769. begin
  770. if assigned(tai_const(hp).endsym) then
  771. begin
  772. if (tai_const(hp).endsym.typ = AT_FUNCTION) and use_PR then
  773. AsmWrite('.');
  774. s:=tai_const(hp).endsym.name;
  775. ReplaceForbiddenChars(s);
  776. AsmWrite(s);
  777. inc(l,length(s));
  778. if tai_const(hp).endsym.typ = AT_FUNCTION then
  779. begin
  780. if use_PR then
  781. AsmWrite('[PR]')
  782. else
  783. AsmWrite('[DS]');
  784. end;
  785. AsmWrite('-');
  786. inc(l,5); {Approx 5 extra, no need to be exactly}
  787. end;
  788. if (tai_const(hp).sym.typ = AT_FUNCTION) and use_PR then
  789. AsmWrite('.');
  790. s:= tai_const(hp).sym.name;
  791. ReplaceForbiddenChars(s);
  792. AsmWrite(s);
  793. inc(l,length(s));
  794. if tai_const(hp).sym.typ = AT_FUNCTION then
  795. begin
  796. if use_PR then
  797. AsmWrite('[PR]')
  798. else
  799. AsmWrite('[DS]');
  800. end;
  801. inc(l,5); {Approx 5 extra, no need to be exactly}
  802. if tai_const(hp).value > 0 then
  803. s:= '+'+tostr(tai_const(hp).value)
  804. else if tai_const(hp).value < 0 then
  805. s:= '-'+tostr(tai_const(hp).value)
  806. else
  807. s:= '';
  808. if s<>'' then
  809. begin
  810. AsmWrite(s);
  811. inc(l,length(s));
  812. end;
  813. end
  814. else
  815. begin
  816. s:= tostr(tai_const(hp).value);
  817. AsmWrite(s);
  818. inc(l,length(s));
  819. end;
  820. if (l>line_length) or
  821. (hp.next=nil) or
  822. (tai(hp.next).typ<>ait_const) or
  823. (tai_const(hp.next).consttype<>consttype) then
  824. break;
  825. hp:=tai(hp.next);
  826. AsmWrite(',');
  827. until false;
  828. AsmLn;
  829. end;
  830. end;
  831. end;
  832. ait_real_64bit :
  833. begin
  834. AsmWriteLn(target_asm.comment+'value: '+double2str(tai_real_64bit(hp).value));
  835. d:=tai_real_64bit(hp).value;
  836. { swap the values to correct endian if required }
  837. if source_info.endian <> target_info.endian then
  838. swap64bitarray(t64bitarray(d));
  839. AsmWrite(#9'dc.b'#9);
  840. begin
  841. for i:=0 to 7 do
  842. begin
  843. if i<>0 then
  844. AsmWrite(',');
  845. AsmWrite(tostr(t64bitarray(d)[i]));
  846. end;
  847. end;
  848. AsmLn;
  849. end;
  850. ait_real_32bit :
  851. begin
  852. AsmWriteLn(target_asm.comment+'value: '+single2str(tai_real_32bit(hp).value));
  853. sin:=tai_real_32bit(hp).value;
  854. { swap the values to correct endian if required }
  855. if source_info.endian <> target_info.endian then
  856. swap32bitarray(t32bitarray(sin));
  857. AsmWrite(#9'dc.b'#9);
  858. for i:=0 to 3 do
  859. begin
  860. if i<>0 then
  861. AsmWrite(',');
  862. AsmWrite(tostr(t32bitarray(sin)[i]));
  863. end;
  864. AsmLn;
  865. end;
  866. ait_string:
  867. begin
  868. {NOTE When a single quote char is encountered, it is
  869. replaced with a numeric ascii value. It could also
  870. have been replaced with the escape seq of double quotes.
  871. Backslash seems to be used as an escape char, although
  872. this is not mentioned in the PPCAsm documentation.}
  873. counter := 0;
  874. lines := tai_string(hp).len div line_length;
  875. { separate lines in different parts }
  876. if tai_string(hp).len > 0 then
  877. begin
  878. for j := 0 to lines-1 do
  879. begin
  880. AsmWrite(#9'dc.b'#9);
  881. quoted:=false;
  882. for i:=counter to counter+line_length-1 do
  883. begin
  884. { it is an ascii character. }
  885. if (ord(tai_string(hp).str[i])>31) and
  886. (ord(tai_string(hp).str[i])<128) and
  887. (tai_string(hp).str[i]<>'''') and
  888. (tai_string(hp).str[i]<>'\') then
  889. begin
  890. if not(quoted) then
  891. begin
  892. if i>counter then
  893. AsmWrite(',');
  894. AsmWrite('''');
  895. end;
  896. AsmWrite(tai_string(hp).str[i]);
  897. quoted:=true;
  898. end { if > 31 and < 128 and ord('"') }
  899. else
  900. begin
  901. if quoted then
  902. AsmWrite('''');
  903. if i>counter then
  904. AsmWrite(',');
  905. quoted:=false;
  906. AsmWrite(tostr(ord(tai_string(hp).str[i])));
  907. end;
  908. end; { end for i:=0 to... }
  909. if quoted then AsmWrite('''');
  910. AsmLn;
  911. counter := counter+line_length;
  912. end; { end for j:=0 ... }
  913. { do last line of lines }
  914. if counter < tai_string(hp).len then
  915. AsmWrite(#9'dc.b'#9);
  916. quoted:=false;
  917. for i:=counter to tai_string(hp).len-1 do
  918. begin
  919. { it is an ascii character. }
  920. if (ord(tai_string(hp).str[i])>31) and
  921. (ord(tai_string(hp).str[i])<128) and
  922. (tai_string(hp).str[i]<>'''') and
  923. (tai_string(hp).str[i]<>'\') then
  924. begin
  925. if not(quoted) then
  926. begin
  927. if i>counter then
  928. AsmWrite(',');
  929. AsmWrite('''');
  930. end;
  931. AsmWrite(tai_string(hp).str[i]);
  932. quoted:=true;
  933. end { if > 31 and < 128 and " }
  934. else
  935. begin
  936. if quoted then
  937. AsmWrite('''');
  938. if i>counter then
  939. AsmWrite(',');
  940. quoted:=false;
  941. AsmWrite(tostr(ord(tai_string(hp).str[i])));
  942. end;
  943. end; { end for i:=0 to... }
  944. if quoted then
  945. AsmWrite('''');
  946. end;
  947. AsmLn;
  948. end;
  949. ait_label:
  950. begin
  951. if tai_label(hp).l.is_used then
  952. begin
  953. s:= tai_label(hp).l.name;
  954. if s[1] = '@' then
  955. begin
  956. ReplaceForbiddenChars(s);
  957. //Local labels:
  958. AsmWriteLn(s+':')
  959. end
  960. else
  961. begin
  962. //Procedure entry points:
  963. if not macos_direct_globals then
  964. begin
  965. WriteDataHeader(s, tai_label(hp).is_global, true);
  966. end
  967. else
  968. begin
  969. ReplaceForbiddenChars(s);
  970. AsmWrite(#9'csect'#9); AsmWrite(s);
  971. AsmWriteLn('[TC]');
  972. AsmWriteLn(PadTabs(s+':',#0));
  973. end;
  974. end;
  975. end;
  976. end;
  977. ait_symbol:
  978. begin
  979. if tai_symbol(hp).sym.typ=AT_FUNCTION then
  980. WriteProcedureHeader(hp)
  981. else if tai_symbol(hp).sym.typ=AT_DATA then
  982. begin
  983. s:= tai_symbol(hp).sym.name;
  984. WriteDataHeader(s, tai_symbol(hp).is_global, true);
  985. if macos_direct_globals then
  986. begin
  987. AsmWrite(s);
  988. AsmWriteLn(':');
  989. end;
  990. end
  991. else
  992. InternalError(2003071301);
  993. end;
  994. ait_symbol_end:
  995. ;
  996. ait_instruction:
  997. WriteInstruction(hp);
  998. ait_stab,
  999. ait_force_line,
  1000. ait_function_name : ;
  1001. ait_cutobject :
  1002. begin
  1003. InternalError(2004101101); {Smart linking is done transparently by the MPW linker.}
  1004. end;
  1005. ait_marker :
  1006. begin
  1007. if tai_marker(hp).kind=InlineStart then
  1008. inc(InlineLevel)
  1009. else if tai_marker(hp).kind=InlineEnd then
  1010. dec(InlineLevel);
  1011. end;
  1012. else
  1013. internalerror(2002110303);
  1014. end;
  1015. hp:=tai(hp.next);
  1016. end;
  1017. end;
  1018. var
  1019. currentasmlist : TExternalAssembler;
  1020. procedure writeexternal(p:tnamedindexitem;arg:pointer);
  1021. var
  1022. s:string;
  1023. replaced: boolean;
  1024. begin
  1025. if tasmsymbol(p).defbind=AB_EXTERNAL then
  1026. begin
  1027. //Writeln('ZZZ ',p.name,' ',p.classname,' ',Ord(tasmsymbol(p).typ));
  1028. s:= p.name;
  1029. replaced:= ReplaceForbiddenChars(s);
  1030. with currentasmlist do
  1031. case tasmsymbol(p).typ of
  1032. AT_FUNCTION:
  1033. begin
  1034. AsmWrite(#9'import'#9'.');
  1035. AsmWrite(s);
  1036. if use_PR then
  1037. AsmWrite('[PR]');
  1038. if replaced then
  1039. begin
  1040. AsmWrite(' <= ''.');
  1041. AsmWrite(p.name);
  1042. if use_PR then
  1043. AsmWrite('[PR]''')
  1044. else
  1045. AsmWrite('''');
  1046. end;
  1047. AsmLn;
  1048. AsmWrite(#9'import'#9);
  1049. AsmWrite(s);
  1050. AsmWrite('[DS]');
  1051. if replaced then
  1052. begin
  1053. AsmWrite(' <= ''');
  1054. AsmWrite(p.name);
  1055. AsmWrite('[DS]''');
  1056. end;
  1057. AsmLn;
  1058. AsmWriteLn(#9'toc');
  1059. AsmWrite(#9'tc'#9);
  1060. AsmWrite(s);
  1061. AsmWrite('[TC],');
  1062. AsmWrite(s);
  1063. AsmWriteLn('[DS]');
  1064. end;
  1065. AT_DATA:
  1066. begin
  1067. AsmWrite(#9'import'#9);
  1068. AsmWrite(s);
  1069. AsmWrite(var_storage_class);
  1070. if replaced then
  1071. begin
  1072. AsmWrite(' <= ''');
  1073. AsmWrite(p.name);
  1074. AsmWrite('''');
  1075. end;
  1076. AsmLn;
  1077. AsmWriteLn(#9'toc');
  1078. AsmWrite(#9'tc'#9);
  1079. AsmWrite(s);
  1080. AsmWrite('[TC],');
  1081. AsmWrite(s);
  1082. AsmWriteLn(var_storage_class);
  1083. end
  1084. else
  1085. InternalError(2003090901);
  1086. end;
  1087. end;
  1088. end;
  1089. procedure TPPCMPWAssembler.WriteExternals;
  1090. begin
  1091. currentasmlist:=self;
  1092. objectlibrary.symbolsearch.foreach_static(@writeexternal,nil);
  1093. end;
  1094. function TPPCMPWAssembler.DoAssemble : boolean;
  1095. var f : file;
  1096. begin
  1097. DoAssemble:=Inherited DoAssemble;
  1098. (*
  1099. { masm does not seem to recognize specific extensions and uses .obj allways PM }
  1100. if (target_asm.id = as_i386_masm) then
  1101. begin
  1102. if not(cs_asm_extern in aktglobalswitches) then
  1103. begin
  1104. if Not FileExists(objfile) and
  1105. FileExists(ForceExtension(objfile,'.obj')) then
  1106. begin
  1107. Assign(F,ForceExtension(objfile,'.obj'));
  1108. Rename(F,objfile);
  1109. end;
  1110. end
  1111. else
  1112. AsmRes.AddAsmCommand('mv',ForceExtension(objfile,'.obj')+' '+objfile,objfile);
  1113. end;
  1114. *)
  1115. end;
  1116. procedure TPPCMPWAssembler.WriteAsmFileHeader;
  1117. begin
  1118. (*
  1119. AsmWriteLn(#9'.386p');
  1120. { masm 6.11 does not seem to like LOCALS PM }
  1121. if (target_asm.id = as_i386_tasm) then
  1122. begin
  1123. AsmWriteLn(#9'LOCALS '+target_asm.labelprefix);
  1124. end;
  1125. AsmWriteLn('DGROUP'#9'GROUP'#9'_BSS,_DATA');
  1126. AsmWriteLn(#9'ASSUME'#9'CS:_CODE,ES:DGROUP,DS:DGROUP,SS:DGROUP');
  1127. AsmLn;
  1128. *)
  1129. AsmWriteLn(#9'string asis'); {Interpret strings just to be the content between the quotes.}
  1130. AsmWriteLn(#9'aligning off'); {We do our own aligning.}
  1131. AsmLn;
  1132. end;
  1133. procedure TPPCMPWAssembler.WriteAsmList;
  1134. var
  1135. hal : tasmlist;
  1136. begin
  1137. {$ifdef EXTDEBUG}
  1138. if assigned(current_module.mainsource) then
  1139. comment(v_info,'Start writing MPW-styled assembler output for '+current_module.mainsource^);
  1140. {$endif}
  1141. LasTSec:=sec_none;
  1142. WriteAsmFileHeader;
  1143. WriteExternals;
  1144. for hal:=low(Tasmlist) to high(Tasmlist) do
  1145. begin
  1146. AsmWriteLn(target_asm.comment+'Begin asmlist '+TasmlistStr[hal]);
  1147. writetree(asmlist[hal]);
  1148. AsmWriteLn(target_asm.comment+'End asmlist '+TasmlistStr[hal]);
  1149. end;
  1150. AsmWriteLn(#9'end');
  1151. AsmLn;
  1152. {$ifdef EXTDEBUG}
  1153. if assigned(current_module.mainsource) then
  1154. comment(v_info,'Done writing MPW-styled assembler output for '+current_module.mainsource^);
  1155. {$endif EXTDEBUG}
  1156. end;
  1157. {*****************************************************************************
  1158. Initialize
  1159. *****************************************************************************}
  1160. const
  1161. as_powerpc_mpw_info : tasminfo =
  1162. (
  1163. id : as_powerpc_mpw;
  1164. idtxt : 'MPW';
  1165. asmbin : 'PPCAsm';
  1166. asmcmd : '-case on $ASM -o $OBJ';
  1167. supported_target : system_any; { what should I write here ?? }
  1168. flags : [af_allowdirect,af_needar,af_smartlink_sections,af_labelprefix_only_inside_procedure];
  1169. labelprefix : '@';
  1170. comment : '; ';
  1171. );
  1172. initialization
  1173. RegisterAssembler(as_powerpc_mpw_info,TPPCMPWAssembler);
  1174. end.