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