{ Copyright (c) 2024 by J. Gareth "Kit" Moreton This unit implements the ARM and AArch64-specific assembly node 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. **************************************************************************** } unit narmbas; {$i fpcdefs.inc} interface uses nbas, ncgbas, aasmtai; type TArmGenAsmNode = class(TCGAsmNode) {$ifdef DEBUG_NODE_XML} procedure XMLPrintNodeData(var T: Text); override; protected function XMLFormatOp(const Oper: POper): string; override; procedure XMLProcessInstruction(var T: Text; p: tai); override; {$endif DEBUG_NODE_XML} end; implementation {$ifdef DEBUG_NODE_XML} uses cutils, cgutils, cgbase, cpubase, itcpugas, aasmcpu, {$ifdef arm} agarmgas, { Needed for gas_shiftmode2str } {$endif arm} {$ifdef aarch64} agcpugas, { Needed for gas_shiftmode2str } {$endif aarch64} verbose; {$endif DEBUG_NODE_XML} {$ifdef DEBUG_NODE_XML} function TArmGenAsmNode.XMLFormatOp(const Oper: POper): string; {$ifdef arm} var NotFirst: Boolean; ThisSupReg: TSuperRegister; {$endif arm} begin case Oper^.typ of top_const: begin case Oper^.val of -15..15: Result := '#' + tostr(Oper^.val); $10..$FF: Result := '#0x' + hexstr(Oper^.val, 2); $100..$FFFF: Result := '#0x' + hexstr(Oper^.val, 4); {$ifdef CPU32} else Result := '#0x' + hexstr(Oper^.val, 8); {$else CPU32} $10000..$FFFFFFFF: Result := '#0x' + hexstr(Oper^.val, 8); else Result := '#0x' + hexstr(Oper^.val, 16); {$endif CPU32} end; end; top_ref: with Oper^.ref^ do begin if Assigned(symbol) then begin Result := symbol.Name; if (offset <> 0) then begin if (offset < 0) then Result := Result + ' - ' + tostr(-offset) else Result := Result + ' + ' + tostr(offset); end; end else begin if (base <> NR_NO) then begin Result := '[' + gas_regname(base); if addressmode = AM_POSTINDEXED then Result := Result + '], ' else if (offset <> 0) or (shiftmode <> SM_None) then Result := Result + ', '; end else { Usually a special kind of reference used by ldm/stm instructions } Result := ''; if index <> NR_NO then Result := Result + gas_regname(index) else if (offset <> 0) or (shiftmode <> SM_None) or (addressmode = AM_POSTINDEXED) then Result := Result + '#' + tostr(offset); {$ifdef arm} if shiftmode = SM_RRX then Result := Result + ', rrx' { Implicit value of 1 } else {$endif arm} if shiftmode <> SM_None then Result := Result + ', ' + gas_shiftmode2str[shiftmode] + ' #' + tostr(shiftimm); if addressmode <> AM_POSTINDEXED then begin if (base <> NR_NO) then Result := Result + ']'; if addressmode = AM_PREINDEXED then Result := Result + '!'; end; end; end; {$ifdef arm} top_regset: begin Result := '{'; NotFirst := False; for ThisSupReg in Oper^.regset^ do begin if NotFirst then Result := Result + ', '; Result := Result + gas_regname(newreg(Oper^.regtyp, ThisSupReg, Oper^.subreg)); NotFirst := True; end; Result := Result + '}'; end; top_specialreg: with Oper^ do begin Result := gas_regname(specialreg) + '_'; if (srC in specialflags) then Result := Result + 'c'; if (srX in specialflags) then Result := Result + 'x'; if (srF in specialflags) then Result := Result + 'f'; if (srS in specialflags) then Result := Result + 's'; end; {$endif arm} {$ifdef aarch64} top_indexedreg: with Oper^ do Result := gas_regname(indexedreg)+'['+tostr(regindex)+']'; {$endif aarch64} top_conditioncode: Result := cond2str[Oper^.cc]; top_realconst: Result := '#' + realtostr(Oper^.val_real); top_shifterop: with Oper^.shifterop^ do begin {$ifdef arm} if shiftmode = SM_RRX then begin Result := 'rrx'; { Implicit value of 1 } Exit; end; Result := gas_shiftmode2str[shiftmode] + ' '; if rs <> NR_NO then Result := Result + gas_regname(rs) else Result := Result + '#' + tostr(shiftimm); {$endif arm} {$ifdef aarch64} Result := gas_shiftmode2str[shiftmode] + ' #' + tostr(shiftimm); {$endif aarch64} end; else Result := inherited XMLFormatOp(Oper); end; end; procedure TArmGenAsmNode.XMLProcessInstruction(var T: Text; p: tai); var ThisOp, ThisOper: string; X: Integer; begin if p.typ = ait_instruction then begin ThisOp := gas_op2str[taicpu(p).opcode] + cond2str[taicpu(p).condition] + oppostfix2str[taicpu(p).oppostfix]; { Pad the opcode with spaces so the succeeding operands are aligned } XMLPadString(ThisOp, 7); Write(T, PrintNodeIndention, ' ', ThisOp); { Extra indentation to account for label formatting } for X := 0 to taicpu(p).ops - 1 do begin Write(T, ' '); ThisOper := XMLFormatOp(taicpu(p).oper[X]); if X < taicpu(p).ops - 1 then begin ThisOper := ThisOper + ','; XMLPadString(ThisOper, 4); end; Write(T, ThisOper); end; WriteLn(T); end else inherited XMLProcessInstruction(T, p); end; procedure TArmGenAsmNode.XMLPrintNodeData(var T: Text); var hp: tai; begin if not Assigned(p_asm) then Exit; hp := tai(p_asm.First); while Assigned(hp) do begin XMLProcessInstruction(T, hp); hp := tai(hp.Next); end; end; {$endif DEBUG_NODE_XML} initialization casmnode := TArmGenAsmNode; end.