我已经优化到60分了
{$inline on}
const
lns=ln(10)；
maxn=125；//四位乘
type
num=
record
w:array[1..maxn+1]of integer；
l:integer；
end；
var
p,i:longint；
t:num；
procedure zl(var a:num)；inline；
var i:integer；
begin
i:=1；
while(a.w[i]>0)or(i<=a.l)do begin
inc(a.w[i+1],a.w[i]div 10000)；
a.w[i]:=a.w[i]mod 10000；
inc(i)；
end；
dec(i)；
if i=0 then i:=1；
a.l:=i；
if a.w[maxn+1]<>0 then begin
a.l:=maxn；
a.w[maxn+1]:=0；
end；
end；//对数进行整理
procedure cy2(var a:num)；inline；
var i:integer；
begin
for i:=1 to a.l do inc(a.w[i],a.w[i])；
zl(a)；
end；//倍乘
begin
read(p)；
writeln(trunc(p*ln(2)/lns)+1)；
t.w[1]:=1；t.l:=1；
for i:=1 to p do cy2(t)；
dec(t.w[1])；
for i:=maxn downto 1 do write(t.w[i]div 1000,(t.w[i]div 100)mod 10,(t.w[i]div 10)mod 10,t.w[i]mod 10)；
end.
b,a:array[1..5000] of longint；
i,len,n:longint；
procedure dd(n:longint)；
var
i,j:longint；
begin
if n=1 then exit；
dd(n shr 1)；
for i:=1 to len do
begin
if i>520 then break；
for j:=1 to len do
begin
if i+j>520 then break；
b[i+j-1]:=b[i+j-1]+a[i]*a[j]；
b[i+j]:=b[i+j]+b[i+j-1] div 10；
b[i+j-1]:=b[i+j-1] mod 10；
end；
end；
if b[len shl 1]<>0 then len:=len shl 1 else len:=len shl 1 -1；
if len>520 then len:=520；
if n and 1=1 then
begin
fillchar(a,sizeof(a),0)；
for i:=1 to len do
begin
if i>520 then break；
a[i]:=a[i]+b[i] shl 1；
a[i+1]:=a[i+1]+a[i] div 10；
a[i]:=a[i] mod 10；
end；
if a[len+1]<>0 then len:=len+1；
if len>520 then len:=520；
end
else
begin
if b[len+1]<>0 then len:=len+1 ；
if len>520 then len:=520；
for i:=1 to len do a[i]:=b[i]；
end；
fillchar(b,sizeof(b),0)；
end；
begin
readln(n)；
writeln(trunc(n*ln(2)/ln(10))+1)；
a[1]:=2；
len:=1；
dd(n)；
a[1]:=a[1]-1；
for i:=500 downto 1 do write(a[i])；
end.