{ $Id$ Copyright (c) 2002 by Florian Klaempfl This unit implements an asmoutput class for PowerPC with MPW syntax This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. **************************************************************************** } { This unit implements an asmoutput class for PowerPC with MPW syntax } unit agppcmpw; {$i fpcdefs.inc} interface uses globals,aasmbase,aasmtai,aasmcpu,assemble, cpubase; const mpw_reg2str : treg2strtable = ('', 'r0','r1','r2','r3','r4','r5','r6','r7','r8','r9','r10','r11','r12','r13','r14','r15','r16', 'r17','r18','r19','r20','r21','r22','r23','r24','r25','r26','r27','r28','r29','r30','r31', 'f0','f1','f2','f3','f4','f5','f6','f7', 'f8','f9','f10','f11','f12', 'f13','f14','f15','f16','f17', 'f18','f19','f20','f21','f22', 'f23','f24', 'f25','f26','f27','f28','f29','f30','f31', 'v0','v1','v2','v3','v4','v5','v6','v7','v8','v9','v10','v11','v12', 'v13','v14','v15','v16','v17','v18','v19','v20','v21','v22', 'v23','v24', 'v25','v26','v27','v28','v29','v30','v31', 'cR','cr0','cr1','cr2','cr3','cr4','cr5','cr6','cr7', 'xer','lr','ctr','fpscr' ); type TPPCMPWAssembler = class(TExternalAssembler) procedure WriteTree(p:TAAsmoutput);override; procedure WriteAsmList;override; Function DoAssemble:boolean;override; procedure WriteExternals; {$ifdef GDB} procedure WriteFileLineInfo(var fileinfo : tfileposinfo); procedure WriteFileEndInfo; {$endif} procedure WriteAsmFileHeader; private procedure GenProcedureHeader(var hp:tai); end; implementation uses {$ifdef delphi} sysutils, {$endif} cutils,globtype,systems,cclasses, verbose,finput,fmodule,script,cpuinfo ; const line_length = 70; {Whether internal procedure references should be xxx[PR]: } use_PR = false; const_storage_class = '[RW]'; {$ifdef GDB} var n_line : byte; { different types of source lines } linecount, includecount : longint; funcname : pchar; stabslastfileinfo : tfileposinfo; isInFunction: Boolean; firstLineInFunction: longint; {$endif} function ReplaceForbiddenChars(var s: string):Boolean; {Returns wheater a replacement has occured.} var i:Integer; {The dollar sign is not allowed in MPW PPCAsm} begin ReplaceForbiddenChars:=false; for i:=1 to Length(s) do if s[i]='$' then begin s[i]:='s'; ReplaceForbiddenChars:=true; end; end; const {*** From here is copyed from agppcgas.pp, except where marked with CHANGED. Perhaps put in a third common file. ***} op2str : array[tasmop] of string[14] = ('', 'add','add.','addo','addo.','addc','addc.','addco','addco.', 'adde','adde.','addeo','addeo.','addi','addic','addic.','addis', 'addme','addme.','addmeo','addmeo.','addze','addze.','addzeo', 'addzeo.','and','and.','andc','andc.','andi.','andis.','b', 'ba','bl','bla','bc','bca','bcl','bcla','bcctr','bcctrl','bclr', 'bclrl','cmp','cmpi','cmpl','cmpli','cntlzw','cntlzw.','crand', 'crandc','creqv','crnand','crnor','cror','crorc','crxor','dcba', 'dcbf','dcbi','dcbst','dcbt','divw','divw.','divwo','divwo.', 'divwu','divwu.','divwuo','divwuo.','eciwx','ecowx','eieio','eqv', 'eqv.','extsb','extsb.','extsh','extsh.','fabs','fabs.','fadd', 'fadd.','fadds','fadds.','fcmpo','fcmpu','fctiw','fctw.','fctwz', 'fctwz.','fdiv','fdiv.','fdivs','fdivs.','fmadd','fmadd.','fmadds', 'fmadds.','fmr','fmsub','fmsub.','fmsubs','fmsubs.','fmul','fmul.', 'fmuls','fmuls.','fnabs','fnabs.','fneg','fneg.','fnmadd', 'fnmadd.','fnmadds','fnmadds.','fnmsub','fnmsub.','fnmsubs', 'fnmsubs.','fres','fres.','frsp','frsp.','frsqrte','frsqrte.', 'fsel','fsel.','fsqrt','fsqrt.','fsqrts','fsqrts.','fsub','fsub.', 'fsubs','fsubs.','icbi','isync','lbz','lbzu','lbzux','lbzx', 'lfd','lfdu','lfdux','lfdx','lfs','lfsu','lfsux','lfsx','lha', 'lhau','lhaux','lhax','hbrx','lhz','lhzu','lhzux','lhzx','lmw', 'lswi','lswx','lwarx','lwbrx','lwz','lwzu','lwzux','lwzx','mcrf', 'mcrfs','mcrxr','lcrxe','mfcr','mffs','maffs.','mfmsr','mfspr','mfsr', 'mfsrin','mftb','mtfcrf','mtfd0','mtfsb1','mtfsf','mtfsf.', 'mtfsfi','mtfsfi.','mtmsr','mtspr','mtsr','mtsrin','mulhw', 'mulhw.','mulhwu','mulhwu.','mulli','mullw','mullw.','mullwo', 'mullwo.','nand','nand.','neg','neg.','nego','nego.','nor','nor.', 'or','or.','orc','orc.','ori','oris', 'rfi', 'rlwimi', 'rlwimi.', 'rlwinm', 'rlwinm.','rlwnm','sc','slw', 'slw.', 'sraw', 'sraw.', 'srawi', 'srawi.','srw', 'srw.', 'stb', 'stbu', 'stbux','stbx','stfd', 'stfdu', 'stfdux', 'stfdx', 'stfiwx', 'stfs', 'stfsu', 'stfsux', 'stfsx', 'sth', 'sthbrx', 'sthu', 'sthux', 'sthx', 'stmw', 'stswi', 'stswx', 'stw', 'stwbrx', 'stwx.', 'stwu', 'stwux', 'stwx', 'subf', 'subf.', 'subfo', 'subfo.', 'subfc', 'subc.', 'subfco', 'subfco.', 'subfe', 'subfe.', 'subfeo', 'subfeo.', 'subfic', 'subfme', 'subfme.', 'subfmeo', 'subfmeo.', 'subfze', 'subfze.', 'subfzeo', 'subfzeo.', 'sync', 'tlbia', 'tlbie', 'tlbsync', 'tw', 'twi', 'xor', 'xor.', 'xori', 'xoris', { some simplified mnemonics } 'subi', 'subis', 'subic', 'subic.', 'sub', 'sub.', 'subo', 'subo.', 'subc', 'subc.', 'subco', 'subco.', 'cmpwi', 'cmpw', 'cmplwi', 'cmplw', 'extlwi', 'extlwi.', 'extrwi', 'extrwi.', 'inslwi', 'inslwi.', 'insrwi', 'insrwi.', 'rotlwi', 'rotlwi.', 'rotlw', 'rotlw.', 'slwi', 'slwi.', 'srwi', 'srwi.', 'clrlwi', 'clrlwi.', 'clrrwi', 'clrrwi.', 'clrslwi', 'clrslwi.', 'blr', 'bctr', 'blrl', 'bctrl', 'crset', 'crclr', 'crmove', 'crnot', 'mt', 'mf','nop', 'li', 'lis', 'la', 'mr','mr.','not', 'mtcr', 'mtlr', 'mflr', 'mtctr', 'mfctr'); function getreferencestring(var ref : treference) : string; var s : string; begin with ref do begin inc(offset,offsetfixup); if (symaddr <> refs_full) then InternalError(2002110301) else if ((offset < -32768) or (offset > 32767)) then InternalError(19991); if assigned(symbol) then begin s:= symbol.name; ReplaceForbiddenChars(s); {if symbol.typ = AT_FUNCTION then ;} s:= s+'[TC]' {ref to TOC entry } end else s:= ''; if offset<0 then s:=s+tostr(offset) else if (offset>0) then begin if assigned(symbol) then s:=s+'+'+tostr(offset) else s:=s+tostr(offset); end; if (index.enum=R_NO) and (base.enum<>R_NO) then begin if offset=0 then if not assigned(symbol) then s:=s+'0'; s:=s+'('+mpw_reg2str[base.enum]+')' end else if (index.enum<>R_NO) and (base.enum<>R_NO) and (offset=0) then s:=s+mpw_reg2str[base.enum]+','+mpw_reg2str[index.enum] else if ((index.enum<>R_NO) or (base.enum<>R_NO)) then internalerror(19992); end; getreferencestring:=s; end; function getopstr_jmp(const o:toper) : string; var hs : string; begin case o.typ of top_reg : getopstr_jmp:=mpw_reg2str[o.reg.enum]; { no top_ref jumping for powerpc } top_const : getopstr_jmp:=tostr(o.val); top_symbol : begin hs:=o.sym.name; ReplaceForbiddenChars(hs); if o.symofs>0 then hs:=hs+'+'+tostr(o.symofs) else if o.symofs<0 then hs:=hs+tostr(o.symofs); getopstr_jmp:=hs; end; top_none: getopstr_jmp:=''; else {$ifndef testing} internalerror(2002070603); {$else testing} begin writeln('internalerror 10001'); halt(1); end; {$endif testing} end; end; function getopstr(const o:toper) : string; var hs : string; begin case o.typ of top_reg: getopstr:=mpw_reg2str[o.reg.enum]; { no top_ref jumping for powerpc } top_const: getopstr:=tostr(longint(o.val)); top_ref: getopstr:=getreferencestring(o.ref^); top_symbol: begin hs:=o.sym.name; ReplaceForbiddenChars(hs); if o.symofs>0 then hs:=hs+'+'+tostr(o.symofs) else if o.symofs<0 then hs:=hs+tostr(o.symofs); getopstr:=hs; end; else {$ifndef testing} internalerror(2002070604); {$else testing} begin writeln('internalerror 10001'); halt(1); end; {$endif testing} end; end; function branchmode(o: tasmop): string[4]; var tempstr: string[4]; begin tempstr := ''; case o of A_BCCTR,A_BCCTRL: tempstr := 'ctr'; A_BCLR,A_BCLRL: tempstr := 'lr'; end; case o of A_BL,A_BLA,A_BCL,A_BCLA,A_BCCTRL,A_BCLRL: tempstr := tempstr+'l'; end; case o of A_BA,A_BLA,A_BCA,A_BCLA: tempstr:=tempstr+'a'; end; branchmode := tempstr; end; function cond2str(op: tasmop; c: tasmcond): string; { note: no checking is performed whether the given combination of } { conditions is valid } var tempstr: string; begin tempstr:=#9; case c.simple of false: cond2str := tempstr+op2str[op]+#9+tostr(c.bo)+','+ tostr(c.bi); true: if (op >= A_B) and (op <= A_BCLRL) then case c.cond of { unconditional branch } C_NONE: cond2str := tempstr+op2str[op]; { bdnzt etc } else begin tempstr := tempstr+'b'+asmcondflag2str[c.cond]+ branchmode(op)+#9; case c.cond of C_LT..C_NU: cond2str := tempstr+mpw_reg2str[c.cr]; C_T..C_DZF: cond2str := tempstr+tostr(c.crbit); end; end; end { we have a trap instruction } else begin internalerror(2002070601); { not yet implemented !!!!!!!!!!!!!!!!!!!!! } { case tempstr := 'tw';} end; end; end; Function GetInstruction(hp : tai):string; {CHANGED from method to proc} var op: TAsmOp; s: string; i: byte; sep: string[3]; begin op:=taicpu(hp).opcode; if is_calljmp(op) then begin { direct BO/BI in op[0] and op[1] not supported, put them in condition! } case op of A_B,A_BA,A_BLA: s:=#9+op2str[op]+#9; A_BCTR,A_BCTRL,A_BLR,A_BLRL: s:=#9+op2str[op]; A_BL: s:=#9+op2str[op]+#9'.'; else s:=cond2str(op,taicpu(hp).condition)+','; end; if (taicpu(hp).oper[0].typ <> top_none) then s:=s+getopstr_jmp(taicpu(hp).oper[0]); if use_PR then if op=A_BL then s:=s+'[PR]'; end else { process operands } begin case op of A_MFSPR: case taicpu(hp).oper[1].reg.enum of R_CR: begin op:=A_MFCR; taicpu(hp).ops:=1; end; R_LR: begin op:=A_MFLR; taicpu(hp).ops:=1; end; else internalerror(2002100701); end; A_MTSPR: case taicpu(hp).oper[1].reg.enum of R_CR: begin op:=A_MTCR; taicpu(hp).ops:=1; end; R_LR: begin op:=A_MTLR; taicpu(hp).ops:=1; end; else internalerror(2002100701); end; end; s:=#9+op2str[op]; if taicpu(hp).ops<>0 then begin sep:=#9; for i:=0 to taicpu(hp).ops-1 do begin s:=s+sep+getopstr(taicpu(hp).oper[i]); sep:=','; end; end; end; GetInstruction:=s; end; {*** Until here is copyed from agppcgas.pp. ***} function single2str(d : single) : string; var hs : string; p : byte; begin str(d,hs); { nasm expects a lowercase e } p:=pos('E',hs); if p>0 then hs[p]:='e'; p:=pos('+',hs); if p>0 then delete(hs,p,1); single2str:=lower(hs); end; function double2str(d : double) : string; var hs : string; p : byte; begin str(d,hs); { nasm expects a lowercase e } p:=pos('E',hs); if p>0 then hs[p]:='e'; p:=pos('+',hs); if p>0 then delete(hs,p,1); double2str:=lower(hs); end; function fixline(s:string):string; { return s with all leading and ending spaces and tabs removed } var i,j,k : longint; begin i:=length(s); while (i>0) and (s[i] in [#9,' ']) do dec(i); j:=1; while (j ''.'+tai_symbol(hp).sym.name+''''); AsmWriteLn(#9'export'#9+s+'[DS] => '''+tai_symbol(hp).sym.name+'[DS]'''); end else begin if not use_PR then AsmWriteLn(#9'export'#9'.'+s); AsmWriteLn(#9'export'#9+s+'[DS]'); end; {Entry in transition vector: } AsmWriteLn(#9'csect'#9+s+'[DS]'); AsmWriteLn(#9'dc.l'#9'.'+s); AsmWriteln(#9'dc.l'#9'TOC[tc0]'); {Entry in TOC: } AsmWriteLn(#9'toc'); AsmWriteLn(#9'tc'#9+s+'[TC],'+s+'[DS]'); end; function GetAdjacentTaiSymbol(var hp:tai):Boolean; begin GetAdjacentTaiSymbol:= false; while assigned(hp.next) do case tai(hp.next).typ of ait_symbol: begin hp:=tai(hp.next); GetAdjacentTaiSymbol:= true; Break; end; ait_stab_function_name: hp:=tai(hp.next); else begin //AsmWriteln(' ;#*#*# ' + tostr(Ord(tai(hp.next).typ))); Break; end; end; end; var first,last: tai; s: string; replaced: boolean; begin s:= tai_symbol(hp).sym.name; {Write all headers} first:= hp; repeat WriteExportHeader(hp); last:= hp; until not GetAdjacentTaiSymbol(hp); {Start the section of the body of the proc: } s:= tai_symbol(last).sym.name; replaced:= ReplaceForbiddenChars(s); if use_PR then if replaced then AsmWriteLn(#9'export'#9'.'+s+'[PR] => ''.'+tai_symbol(last).sym.name+'[PR]''') else AsmWriteLn(#9'export'#9'.'+s+'[PR]'); AsmWriteLn(#9'csect'#9'.'+s+'[PR]'); //starts the section AsmWriteLn(#9'function'#9'.'+s+'[PR]'); //info for debugger {$ifdef GDB} if ((cs_debuginfo in aktmoduleswitches) or (cs_gdb_lineinfo in aktglobalswitches)) then begin //info for debuggers: firstLineInFunction:= stabslastfileinfo.line; AsmWriteLn(#9'beginf ' + tostr(firstLineInFunction)); isInFunction:= true; end; {$endif} {Write all labels: } hp:= first; repeat s:= tai_symbol(hp).sym.name; ReplaceForbiddenChars(s); AsmWriteLn('.'+s+':'); until not GetAdjacentTaiSymbol(hp); end; (* procedure TPPCMPWAssembler.GenProcedureHeader(hp:tai); var s: string; replaced: boolean; begin s:= tai_symbol(hp).sym.name; replaced:= ReplaceForbiddenChars(s); if replaced then begin AsmWriteLn(#9'export'#9'.'+s+'[PR] => ''.'+tai_symbol(hp).sym.name+'[PR]'''); AsmWriteLn(#9'export'#9+s+'[DS] => '''+tai_symbol(hp).sym.name+'[DS]'''); end else begin AsmWriteLn(#9'export'#9'.'+s+'[PR]'); AsmWriteLn(#9'export'#9+s+'[DS]'); end; {Entry in transition vector: } AsmWriteLn(#9'csect'#9+s+'[DS]'); AsmWriteLn(#9'dc.l'#9'.'+s); AsmWriteln(#9'dc.l'#9'TOC[tc0]'); {Entry in TOC: } AsmWriteLn(#9'toc'); AsmWriteLn(#9'tc'#9+s+'[TC],'+s+'[DS]'); {Start the section of the body of the proc: } AsmWriteLn(#9'csect'#9'.'+s+'[PR]'); AsmWriteLn('.'+s+':'); end; *) var LasTSec : TSection; lastfileinfo : tfileposinfo; infile, lastinfile : tinputfile; const ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]= (#9'dc.l'#9,#9'dc.w'#9,#9'dc.b'#9); Function PadTabs(const p:string;addch:char):string; var s : string; i : longint; begin i:=length(p); if addch<>#0 then begin inc(i); s:=p+addch; end else s:=p; if i<8 then PadTabs:=s+#9#9 else PadTabs:=s+#9; end; {$ifdef GDB} procedure TPPCMPWAssembler.WriteFileLineInfo(var fileinfo : tfileposinfo); var curr_n : byte; begin if not ((cs_debuginfo in aktmoduleswitches) or (cs_gdb_lineinfo in aktglobalswitches)) then exit; { file changed ? (must be before line info) } if (fileinfo.fileindex<>0) and (stabslastfileinfo.fileindex<>fileinfo.fileindex) then begin infile:=current_module.sourcefiles.get_file(fileinfo.fileindex); if assigned(infile) then begin (* if includecount=0 then curr_n:=n_sourcefile else curr_n:=n_includefile; if (infile.path^<>'') then begin AsmWriteLn(#9'.stabs "'+lower(BsToSlash(FixPath(infile.path^,false)))+'",'+ tostr(curr_n)+',0,0,'+target_asm.labelprefix+'text'+ToStr(IncludeCount)); end; AsmWriteLn(#9'.stabs "'+lower(FixFileName(infile.name^))+'",'+ tostr(curr_n)+',0,0,'+target_asm.labelprefix+'text'+ToStr(IncludeCount)); *) AsmWriteLn(#9'file '''+lower(FixFileName(infile.name^))+''''); (* AsmWriteLn(target_asm.labelprefix+'text'+ToStr(IncludeCount)+':'); *) inc(includecount); { force new line info } stabslastfileinfo.line:=-1; end; end; { line changed ? } if (stabslastfileinfo.line<>fileinfo.line) and (fileinfo.line<>0) then begin (* if (n_line=n_textline) and assigned(funcname) and (target_info.use_function_relative_addresses) then begin AsmWriteLn(target_asm.labelprefix+'l'+tostr(linecount)+':'); AsmWrite(#9'.stabn '+tostr(n_line)+',0,'+tostr(fileinfo.line)+','+ target_asm.labelprefix+'l'+tostr(linecount)+' - '); AsmWritePChar(FuncName); AsmLn; inc(linecount); end else AsmWriteLn(#9'.stabd'#9+tostr(n_line)+',0,'+tostr(fileinfo.line)); *) if isInFunction then AsmWriteln(#9'line '+ tostr(fileinfo.line - firstLineInFunction - 1)); end; stabslastfileinfo:=fileinfo; end; procedure TPPCMPWAssembler.WriteFileEndInfo; begin if not ((cs_debuginfo in aktmoduleswitches) or (cs_gdb_lineinfo in aktglobalswitches)) then exit; AsmLn; (* AsmWriteLn(ait_section2str(sec_code)); AsmWriteLn(#9'.stabs "",'+tostr(n_sourcefile)+',0,0,'+target_asm.labelprefix+'etext'); AsmWriteLn(target_asm.labelprefix+'etext:'); *) end; {$endif} procedure TPPCMPWAssembler.WriteTree(p:TAAsmoutput); var s, prefix, suffix : string; hp : tai; hp1 : tailineinfo; counter, lines, InlineLevel : longint; i,j,l : longint; consttyp : taitype; found, do_line,DoNotSplitLine, quoted : boolean; sep : char; replaced : boolean; begin if not assigned(p) then exit; InlineLevel:=0; { lineinfo is only needed for codesegment (PFV) } do_line:=((cs_asm_source in aktglobalswitches) or (cs_lineinfo in aktmoduleswitches)) and (p=codesegment); DoNotSplitLine:=false; hp:=tai(p.first); while assigned(hp) do begin if not(hp.typ in SkipLineInfo) and not DoNotSplitLine then begin hp1 := hp as tailineinfo; {$ifdef GDB} { write debug info } if (cs_debuginfo in aktmoduleswitches) or (cs_gdb_lineinfo in aktglobalswitches) then WriteFileLineInfo(hp1.fileinfo); {$endif GDB} if do_line then begin { load infile } if lastfileinfo.fileindex<>hp1.fileinfo.fileindex then begin infile:=current_module.sourcefiles.get_file(hp1.fileinfo.fileindex); if assigned(infile) then begin { open only if needed !! } if (cs_asm_source in aktglobalswitches) then infile.open; end; { avoid unnecessary reopens of the same file !! } lastfileinfo.fileindex:=hp1.fileinfo.fileindex; { be sure to change line !! } lastfileinfo.line:=-1; end; { write source } if (cs_asm_source in aktglobalswitches) and assigned(infile) then begin if (infile<>lastinfile) then begin AsmWriteLn(target_asm.comment+'['+infile.name^+']'); if assigned(lastinfile) then lastinfile.close; end; if (hp1.fileinfo.line<>lastfileinfo.line) and ((hp1.fileinfo.line0)) then begin if (hp1.fileinfo.line<>0) and ((infile.linebuf^[hp1.fileinfo.line]>=0) or (InlineLevel>0)) then AsmWriteLn(target_asm.comment+'['+tostr(hp1.fileinfo.line)+'] '+ fixline(infile.GetLineStr(hp1.fileinfo.line))); { set it to a negative value ! to make that is has been read already !! PM } if (infile.linebuf^[hp1.fileinfo.line]>=0) then infile.linebuf^[hp1.fileinfo.line]:=-infile.linebuf^[hp1.fileinfo.line]-1; end; end; lastfileinfo:=hp1.fileinfo; lastinfile:=infile; end; end; DoNotSplitLine:=false; case hp.typ of ait_comment: begin AsmWrite(target_asm.comment); AsmWritePChar(tai_comment(hp).str); AsmLn; end; ait_regalloc, ait_tempalloc: ; ait_section: begin {if LasTSec<>sec_none then AsmWriteLn('_'+target_asm.secnames[LasTSec]+#9#9'ENDS');} if tai_section(hp).sec<>sec_none then begin AsmLn; AsmWriteLn(#9+target_asm.secnames[tai_section(hp).sec]); {$ifdef GDB} lastfileinfo.line:=-1; {$endif GDB} end; LasTSec:=tai_section(hp).sec; end; ait_align: begin case tai_align(hp).aligntype of 1:AsmWriteLn(#9'align 0'); 2:AsmWriteLn(#9'align 1'); 4:AsmWriteLn(#9'align 2'); otherwise internalerror(2002110302); end; end; ait_datablock: begin s:= tai_datablock(hp).sym.name; replaced:= ReplaceForbiddenChars(s); if tai_datablock(hp).is_global then if replaced then AsmWriteLn(#9'export'#9+s+'[RW] => '''+tai_datablock(hp).sym.name+'''') else AsmWriteLn(#9'export'#9+s+'[RW]'); if not macos_direct_globals then begin AsmWriteLn(#9'toc'); AsmWriteLn(#9'tc'#9+s+'[TC], '+s+'[RW]'); AsmWriteLn(#9'csect'#9+s+'[RW]'); AsmWriteLn(#9'ds.b '+tostr(tai_datablock(hp).size)); end else begin AsmWriteLn(#9'csect'#9+s+'[TC]'); AsmWriteLn(PadTabs(s+':',#0)+'ds.b '+tostr(tai_datablock(hp).size)); {TODO: ? PadTabs(s,#0) } end; end; ait_const_32bit, ait_const_8bit, ait_const_16bit : begin AsmWrite(ait_const2str[hp.typ]+tostr(tai_const(hp).value)); consttyp:=hp.typ; l:=0; repeat found:=(not (tai(hp.next)=nil)) and (tai(hp.next).typ=consttyp); if found then begin hp:=tai(hp.next); s:=','+tostr(tai_const(hp).value); AsmWrite(s); inc(l,length(s)); end; until (not found) or (l>line_length); AsmLn; end; ait_const_symbol: begin (* AsmWriteLn(#9#9'dd'#9'offset '+tai_const_symbol(hp).sym.name); if tai_const_symbol(hp).offset>0 then AsmWrite('+'+tostr(tai_const_symbol(hp).offset)) else if tai_const_symbol(hp).offset<0 then AsmWrite(tostr(tai_const_symbol(hp).offset)); AsmLn; *) s:= tai_const_symbol(hp).sym.name; ReplaceForbiddenChars(s); if tai_const_symbol(hp).sym.typ = AT_FUNCTION then begin if use_PR then AsmWriteLn(#9'dc.l'#9'.'+ s +'[PR]') else AsmWriteLn(#9'dc.l'#9 + s + '[DS]') end else begin if macos_direct_globals then AsmWriteLn(#9'dc.l'#9+s) else AsmWriteLn(#9'dc.l'#9+s+const_storage_class); end; (* TODO: the following might need to be included. Temporaily we generate an error if tai_const_symbol(hp).offset>0 then AsmWrite('+'+tostr(tai_const_symbol(hp).offset)) else if tai_const_symbol(hp).offset<0 then AsmWrite(tostr(tai_const_symbol(hp).offset)); *) if tai_const_symbol(hp).offset <> 0 then InternalError(2002110101); AsmLn; end; ait_real_32bit: AsmWriteLn(#9'dc.l'#9'"'+single2str(tai_real_32bit(hp).value)+'"'); ait_real_64bit: AsmWriteLn(#9'dc.d'#9'"'+double2str(tai_real_64bit(hp).value)+'"'); ait_string: begin {NOTE When a single quote char is encountered, it is replaced with a numeric ascii value. It could also have been replaced with the escape seq of double quotes.} counter := 0; lines := tai_string(hp).len div line_length; { separate lines in different parts } if tai_string(hp).len > 0 then Begin for j := 0 to lines-1 do begin AsmWrite(#9'dc.b'#9); quoted:=false; for i:=counter to counter+line_length do begin { it is an ascii character. } if (ord(tai_string(hp).str[i])>31) and (ord(tai_string(hp).str[i])<128) and (tai_string(hp).str[i]<>'''') then begin if not(quoted) then begin if i>counter then AsmWrite(','); AsmWrite(''''); end; AsmWrite(tai_string(hp).str[i]); quoted:=true; end { if > 31 and < 128 and ord('"') } else begin if quoted then AsmWrite(''''); if i>counter then AsmWrite(','); quoted:=false; AsmWrite(tostr(ord(tai_string(hp).str[i]))); end; end; { end for i:=0 to... } if quoted then AsmWrite(''''); AsmWrite(target_info.newline); counter := counter+line_length; end; { end for j:=0 ... } { do last line of lines } AsmWrite(#9'dc.b'#9); quoted:=false; for i:=counter to tai_string(hp).len-1 do begin { it is an ascii character. } if (ord(tai_string(hp).str[i])>31) and (ord(tai_string(hp).str[i])<128) and (tai_string(hp).str[i]<>'''') then begin if not(quoted) then begin if i>counter then AsmWrite(','); AsmWrite(''''); end; AsmWrite(tai_string(hp).str[i]); quoted:=true; end { if > 31 and < 128 and " } else begin if quoted then AsmWrite(''''); if i>counter then AsmWrite(','); quoted:=false; AsmWrite(tostr(ord(tai_string(hp).str[i]))); end; end; { end for i:=0 to... } if quoted then AsmWrite(''''); end; AsmLn; end; ait_label: begin if tai_label(hp).l.is_used then begin s:= tai_label(hp).l.name; ReplaceForbiddenChars(s); if s[1] = '@' then AsmWriteLn(s+':') else begin if not macos_direct_globals then begin AsmWriteLn(#9'toc'); AsmWriteLn(#9'tc'#9+s+'[TC], '+s+const_storage_class); AsmWriteLn(#9'csect'#9+s+const_storage_class); end else begin AsmWriteLn(#9'csect'#9+s+'[TC]'); AsmWriteLn(PadTabs(s+':',#0)); end; end; end; end; ait_direct: begin AsmWritePChar(tai_direct(hp).str); AsmLn; end; ait_symbol: begin if tai_symbol(hp).sym.typ=AT_FUNCTION then GenProcedureHeader(hp) else begin s:= tai_symbol(hp).sym.name; replaced:= ReplaceForbiddenChars(s); if tai_symbol(hp).is_global then if replaced then AsmWriteLn(#9'export'#9+s+'[RW] => '''+tai_symbol(hp).sym.name+'''') else AsmWriteLn(#9'export'#9+s+'[RW]'); if not macos_direct_globals then begin AsmWriteLn(#9'toc'); AsmWriteLn(#9'tc'#9+s+'[TC], '+s+ const_storage_class); AsmWriteLn(#9'csect'#9+s+ const_storage_class); end else begin AsmWriteLn(#9'csect'#9+s+'[TC]'); AsmWriteLn(s+':'); end; end; end; ait_symbol_end: {$ifdef GDB} if isInFunction then if ((cs_debuginfo in aktmoduleswitches) or (cs_gdb_lineinfo in aktglobalswitches)) then begin //info for debuggers: AsmWriteLn(#9'endf ' + tostr(stabslastfileinfo.line)); isInFunction:= false; end {$endif GDB} ; ait_instruction: AsmWriteLn(GetInstruction(hp)); {$ifdef GDB} ait_stabn: ; ait_stabs: ; ait_force_line : stabslastfileinfo.line:=0; ait_stab_function_name: ; {$endif GDB} ait_cut : begin { only reset buffer if nothing has changed } if AsmSize=AsmStartSize then AsmClear else begin { if LasTSec<>sec_none then AsmWriteLn('_'+target_asm.secnames[LasTSec]+#9#9'ends'); AsmLn; } AsmWriteLn(#9'end'); AsmClose; DoAssemble; AsmCreate(tai_cut(hp).place); end; { avoid empty files } while assigned(hp.next) and (tai(hp.next).typ in [ait_cut,ait_section,ait_comment]) do begin if tai(hp.next).typ=ait_section then begin lasTSec:=tai_section(hp.next).sec; end; hp:=tai(hp.next); end; WriteAsmFileHeader; if lasTSec<>sec_none then AsmWriteLn(#9+target_asm.secnames[lasTSec]); { AsmWriteLn('_'+target_asm.secnames[lasTSec]+#9#9+ 'SEGMENT'#9'PARA PUBLIC USE32 '''+ target_asm.secnames[lasTSec]+''''); } AsmStartSize:=AsmSize; end; ait_marker : begin if tai_marker(hp).kind=InlineStart then inc(InlineLevel) else if tai_marker(hp).kind=InlineEnd then dec(InlineLevel); end; else internalerror(2002110303); end; hp:=tai(hp.next); end; end; var currentasmlist : TExternalAssembler; procedure writeexternal(p:tnamedindexitem;arg:pointer); var s:string; begin if tasmsymbol(p).defbind=AB_EXTERNAL then begin //Writeln('ZZZ ',p.name,' ',p.classname,' ',Ord(tasmsymbol(p).typ)); s:= p.name; case tasmsymbol(p).typ of AT_FUNCTION: begin if ReplaceForbiddenChars(s) then begin if not use_PR then currentasmlist.AsmWriteLn(#9'import'#9'.'+s+' <= ''.'+p.name+'''') else currentasmlist.AsmWriteLn(#9'import'#9'.'+s+'[PR] <= ''.'+p.name+'[PR]'''); currentasmlist.AsmWriteLn(#9'import'#9+s+'[DS] <= '''+p.name+'[DS]'''); end else begin if not use_PR then currentasmlist.AsmWriteLn(#9'import'#9'.'+s) else currentasmlist.AsmWriteLn(#9'import'#9'.'+s+'[PR]'); currentasmlist.AsmWriteLn(#9'import'#9+s+'[DS]'); end; currentasmlist.AsmWriteLn(#9'toc'); currentasmlist.AsmWriteLn(#9'tc'#9+s+'[TC],'+s+'[DS]'); end else begin if ReplaceForbiddenChars(s) then currentasmlist.AsmWriteLn(#9'import'#9+s+'[RW] <= '''+p.name+'''') else currentasmlist.AsmWriteLn(#9'import'#9+s+'[RW]'); currentasmlist.AsmWriteLn(#9'toc'); currentasmlist.AsmWriteLn(#9'tc'#9+s+'[TC],'+s+'[RW]'); end; end; end; end; procedure TPPCMPWAssembler.WriteExternals; begin currentasmlist:=self; objectlibrary.symbolsearch.foreach_static({$ifdef fpcprocvar}@{$endif}writeexternal,nil); end; function TPPCMPWAssembler.DoAssemble : boolean; var f : file; begin DoAssemble:=Inherited DoAssemble; (* { masm does not seem to recognize specific extensions and uses .obj allways PM } if (aktoutputformat = as_i386_masm) then begin if not(cs_asm_extern in aktglobalswitches) then begin if Not FileExists(objfile) and FileExists(ForceExtension(objfile,'.obj')) then begin Assign(F,ForceExtension(objfile,'.obj')); Rename(F,objfile); end; end else AsmRes.AddAsmCommand('mv',ForceExtension(objfile,'.obj')+' '+objfile,objfile); end; *) end; procedure TPPCMPWAssembler.WriteAsmFileHeader; begin (* AsmWriteLn(#9'.386p'); { masm 6.11 does not seem to like LOCALS PM } if (aktoutputformat = as_i386_tasm) then begin AsmWriteLn(#9'LOCALS '+target_asm.labelprefix); end; AsmWriteLn('DGROUP'#9'GROUP'#9'_BSS,_DATA'); AsmWriteLn(#9'ASSUME'#9'CS:_CODE,ES:DGROUP,DS:DGROUP,SS:DGROUP'); AsmLn; *) AsmWriteLn(#9'string asis'); {Interpret strings just to be the content between the quotes.} AsmLn; end; procedure TPPCMPWAssembler.WriteAsmList; {$ifdef GDB} var fileinfo : tfileposinfo; {$endif GDB} begin {$ifdef EXTDEBUG} if assigned(current_module.mainsource) then comment(v_info,'Start writing MPW-styled assembler output for '+current_module.mainsource^); {$endif} LasTSec:=sec_none; {$ifdef GDB} FillChar(stabslastfileinfo,sizeof(stabslastfileinfo),0); {$endif GDB} {$ifdef GDB} //n_line:=n_bssline; funcname:=nil; linecount:=1; includecount:=0; fileinfo.fileindex:=1; fileinfo.line:=1; isInFunction:= false; firstLineInFunction:= 0; { Write main file } WriteFileLineInfo(fileinfo); {$endif GDB} WriteAsmFileHeader; WriteExternals; { PowerPC MPW ASM doesn't support stabs, as we now. WriteTree(debuglist);} WriteTree(codesegment); WriteTree(datasegment); WriteTree(consts); WriteTree(rttilist); WriteTree(resourcestringlist); WriteTree(bsssegment); {$ifdef GDB} WriteFileEndInfo; {$ENDIF} AsmWriteLn(#9'end'); AsmLn; {$ifdef EXTDEBUG} if assigned(current_module.mainsource) then comment(v_info,'Done writing MPW-styled assembler output for '+current_module.mainsource^); {$endif EXTDEBUG} end; {***************************************************************************** Initialize *****************************************************************************} const as_powerpc_mpw_info : tasminfo = ( id : as_powerpc_mpw; idtxt : 'MPW'; asmbin : 'PPCAsm'; asmcmd : ''; supported_target : system_any; { what should I write here ?? } outputbinary: false; allowdirect : true; needar : true; labelprefix_only_inside_procedure : true; labelprefix : '@'; comment : '; '; secnames : ('', 'csect','csect [TC]','csect [TC]', {TODO: Perhaps use other section types.} '','','','','','', '','','') ); initialization RegisterAssembler(as_powerpc_mpw_info,TPPCMPWAssembler); end. { $Log$ Revision 1.19 2003-04-06 21:01:40 olle + line numbers are now emitted in the assembler code * bug in export and import directive fixed * made code more in sync with aggas.pas Revision 1.18 2003/01/13 17:17:50 olle * changed global var access, TOC now contain pointers to globals * fixed handling of function pointers Revision 1.17 2003/01/08 18:43:57 daniel * Tregister changed into a record Revision 1.16 2002/11/28 10:56:07 olle * changed proc ref from .xxx[PR] (refering to its section) to .xxx (refering to its label) to allow for multiple ref to a proc. Revision 1.15 2002/11/17 16:31:59 carl * memory optimization (3-4%) : cleanup of tai fields, cleanup of tdef and tsym fields. * make it work for m68k Revision 1.14 2002/11/07 15:50:23 jonas * fixed bctr(l) problems Revision 1.13 2002/11/04 18:24:53 olle * globals are located in TOC and relative r2, instead of absolute * symbols which only differs in case are treated as a single symbol + tai_const_symbol supported * only refs_full accepted Revision 1.12 2002/10/23 15:31:01 olle * branch b does not jump to dotted symbol now Revision 1.11 2002/10/19 23:52:40 olle * import directive changed Revision 1.10 2002/10/10 19:39:37 florian * changes from Olle to get simple programs compiled and assembled Revision 1.9 2002/10/07 21:19:53 florian * more mpw fixes Revision 1.8 2002/10/06 22:46:20 florian * fixed function exporting Revision 1.7 2002/10/02 22:14:15 florian * improve function imports Revision 1.6 2002/09/27 21:09:49 florian + readed because previous version was broken Revision 1.2 2002/08/31 12:43:31 florian * ppc compilation fixed Revision 1.1 2002/08/20 21:40:44 florian + target macos for ppc added + frame work for mpw assembler output }