C++ :

#include<iostream>
#include<string.h>
using namespace std;
const int Max = 5000;
int len,d,lim=30;
char str[Max],rts[Max];

void fz(char a[Max],char b[Max])
{
    for (int i=0;i<len;++i)
        a[i] = b[len-1-i];
}

void add()
{
    int c = 0;
    for (int i=0;i<len;++i)
    {
         rts[i] += str[i] - '0' + c;
         c = (rts[i] - '0')/d;
         rts[i] = (rts[i] - '0')%d + '0';
    }
	if (c) rts[len] = '0' + c;
}

bool judge()
{
    for (int i = 0;i<len;++i)
        if (rts[i]!=rts[len-1-i]) return 0;
    return 1;
}

int main()
{
    cin>>d>>str;
    int i ;
	for (i=0;i<strlen(str);++i)
	{
		if ('A'<=str[i] && str[i]<='Z')
			str[i] = str[i] - 'A' + '9' + 1;
	}
    for (i=0;i<=lim;++i)
    {
        len = strlen(str);
        fz(rts,str);if (judge()==1) break;
        add();
        len = strlen(rts);     
        fz(str,rts);
	//    cout<<str<<endl;
    }
    if (i<=lim) cout<<"STEP="<<i<<endl;
    else cout<<"Impossible!"<<endl;
}

Pascal :

var s,s1:string;n,t,i,l:longint;x,y:array[1..100]of integer;flag:boolean;
begin
  readln(n);
  readln(s);
  t:=0;
  repeat
    inc(t);
    s1:='';
    for i:=length(s) downto 1 do
      s1:=s1+s[i];
    if n=16 then
      begin
        fillchar(x,sizeof(x),0);
        fillchar(y,sizeof(y),0);
        for i:=1 to length(s) do
          if s[i]>='A' then x[i]:=ord(s[length(s)+1-i])-ord('A')+10
          else x[i]:=ord(s[length(s)+1-i])-48;
        for i:=1 to length(s1) do
          if s1[i]>='A' then y[i]:=ord(s1[length(s1)+1-i])-ord('A')+10
          else y[i]:=ord(s1[length(s1)+1-i])-48;
        for i:=1 to length(s) do
          begin
            x[i]:=x[i]+y[i];
            x[i+1]:=x[i+1]+x[i] div 16;
            x[i]:=x[i] mod 16;
          end;
        if x[length(s)+1]<>0 then l:=length(s)+1
        else l:=length(s);
        s:='';
        for i:=l downto 1 do
          if x[i]>=10 then s:=s+chr(ord('A')+x[i]-10)
          else s:=s+chr(x[i]+48);
      end
    else
      begin
        fillchar(x,sizeof(x),0);
        fillchar(y,sizeof(y),0);
        for i:=1 to length(s) do
          x[i]:=ord(s[length(s)+1-i])-48;
        for i:=1 to length(s1) do
          y[i]:=ord(s1[length(s1)+1-i])-48;
        for i:=1 to length(s) do
          begin
            x[i]:=x[i]+y[i];
            x[i+1]:=x[i+1]+x[i] div n;
            x[i]:=x[i] mod n;
          end;
        if x[length(s)+1]<>0 then l:=length(s)+1
        else l:=length(s);
        s:='';
        for i:=l downto 1 do
          s:=s+chr(x[i]+48);
      end;
    flag:=true;
    for i:=1 to length(s) div 2 do
      if s[i]<>s[length(s)+1-i] then
        begin
          flag:=false;
          break;
        end;
    if flag then
      begin
        writeln('STEP=',t);
        halt;
      end;
  until t=30;
  writeln('Impossible!');
end.