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