agppcmpw.pas 39 KB

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