Pensieve Header: See also 2009-01/Very Large Numbers.

Step[{n_}] := n;
Step[{n_, 1}] := {n+2};
Step[{n_,1,1,rest___}] := {n+2, 1, rest};
Step[{n_,1,2,1,rest___}] := {2n+2, 1, rest};
Step[{n_, rest__}] /; FreeQ[Rest[{rest}], 1]:= (
k=Last[{rest}]-1;
{k} = Last[Position[{rest}, k,1]];
Flatten[{
2,
Take[{rest}, k-1],
Table[Take[{rest}, {k,-2}], {n}]
}]
);
Step[{n_, rest__}] /; MemberQ[Rest[{rest}], 1]:= (
{l} = Last[Position[{rest},1,1,2]];
k={rest}[[l-1]]-1;
{k} = Last[Position[Take[{rest},l-2], k,1]];
Flatten[{
2,
Take[{rest}, k-1],
Table[Take[{rest}, {k,l-2}], {n}],
Drop[{rest}, l-1]
}]
);

s={4,1,2,2};
steps =0;
While[Head[s] === List && ++steps<500 && Length[s]<1000, Print[s=Step[s]]];
s