FMessage: string

function GetMessage: string;
begin
  Lock;
  try
    Result := FMessage;
  finally
    Unlock;
  end;
end;

function GetMessage: string;
begin
  Lock;
  try
    Result := FMessage;
    UniqueString(Result);
  finally
    Unlock;
  end;
end;

function _UStrClr(var S): Pointer;
var
  P: PStrRec;
begin
  if Pointer(S) <> nil then
  begin
    P := Pointer(PByte(S) - SizeOf(StrRec));
    Pointer(S) := nil;
    if P.refCnt > 0 then
    begin
      if AtomicDecrement(P.refCnt) = 0 then
        FreeMem(P);
    end;
  end;
  Result := @S;
end;

mov eax, [v]

procedure _UStrAsg(var Dest: UnicodeString; const Source: UnicodeString); // globals (need copy)
{$IFDEF PUREPASCAL}
var
  S, D: Pointer;
  P: PStrRec;
  Len: LongInt;
begin
  S := Pointer(Source);
  if S <> nil then
  begin
    if __StringRefCnt(Source) < 0 then   // make copy of string literal
    begin
      Len := __StringLength(Source);
      S := _NewUnicodeString(Len);
      Move(Pointer(Source)^, S^, Len * SizeOf(WideChar));
    end else
    begin
      P := PStrRec(PByte(S) - SizeOf(StrRec));
      AtomicIncrement(P.refCnt);
    end;
  end;
  D := Pointer(Dest);
  Pointer(Dest) := S;
  _UStrClr(D);
end;

  StrRec = packed record
  {$IF defined(CPUX64)}
    _Padding: LongInt; // Make 16 byte align for payload..
  {$ENDIF}
    codePage: Word;
    elemSize: Word;
    refCnt: Longint;
    length: Longint;
    data: array[0...] of Char;
  end;

function GetMessage: string;
begin
  Lock;
  try
    Result := FMessage;
  finally
    Unlock;
  end;
end;

FMessage: Pointer;
....
function GetMessage: Pointer;
begin
  Lock;
  try
    AddRef(FMessage)
    Result := FMessage;
  finally
    Unlock;
  end;
end;