%routine Evaluate String Expression(%record(Stackfm)%name V)
   %record(Stackfm)%name W
   W == Claim Work Area(256, Strings)
   String Assign(V, W)
   Replace(V, W)
%end

%routine String Assign(%record(Stackfm)%name R, L)
   %record(Stackfm)%name W, LL, DelayV, Z
   %integer Conc Length = 1, All Const = 1, Reg, Delay = 0, Len = 0
   %integer Here, Lab, N
   %string(255) Val = ""

   %predicate Safe(%record(Stackfm)%name Target, Chain)
      %cycle
         Conc Length = Conc Length+1
         Conc Length = -1000 %if Chain_Type > Addrs
         All Const = 0 %unless Iconst Item(Chain)
         Val = Val.Tostring(Chain_Disp&255) %if All Const # 0
         %false %if Same(Target, Chain) %or (Target_Index ## Nil %and
                                              Chain_Index ## Nil)
         Chain == Chain_Link
      %repeat %until Chain == Nil
      %true
   %end

   %routine Move1
      Forget(L_Base);  Forget(R_Base)
      Simple(R, L)
   %end


   Forget Destination(L)
   %if R_Oper = 0 %start
      {**********************************}
      {*** Simple assignment:   S = T ***}
      {**********************************}

      N = R_Bias
      %if N # 0 %start                            {constant string}
         %if N = 1 %start                         {L = ""}
            L == Copy(L);  L_Type = Bytes
            R == Literal(0)
            Simple(R, L)
         %else %if N < 0                          {implied tostring}
   Ctos:    L == Copy(L)
            Advance(L, Bytes, 1);   Simple(R, L)  {plug the character}
            R == Literal(1)
            Advance(L, Bytes, -1);  Simple(R, L)  {plug the length}
         %else                                    {move in N bytes}
            L == Copy(L);  Make AutoI(L, Bytes)
            R == Copy(R);  Make AutoI(R, Bytes)
            Repeat(Move1, Literal(N), 1, NE)      {NOTE length(S)+1}
         %finish
         Release and Drop Pair(L, R)
      %else %if R_Type <= Addrs             {implied tostring}
         ->Ctos %if Iconst Item(R)
         W == Copy(L);  Advance(W, Bytes, 1)
         Simple(R, W);  Release and Drop(W)
         L == Copy(L);  L_Type = Bytes
         Move Literal(1, L);                          Release and Drop(L)
      %else                                  {Variable string}
         L == Copy(L);  Make AutoI(L, Bytes)
         R == Copy(R);  Make AutoI(R, Bytes)
         W == Copy(R);  W_Form = Direct
         Repeat(Move1, W, 1, GE)
         Release and Drop Pair(L, R)
      %finish
      %return
   %finish

   {**************************************}
   {*** Complex assignment: S = A.B... ***}
   {**************************************}

      %routine Assign via Work
         %record(Stackfm)%name W
         W == Claim Work Area(255, Strings)
         String Assign(R, W)
         String Assign(W, L)
         Release and Drop(W)
      %end

   W == R_Link
   %unless Safe(L, W) %start
      Assign via Work;  %return
   %finish

   R_OpLink = 0
   %if Conc Length > 0 %and R_Type <= Addrs %start         {all tostrings}
      L == Copy(L)
      All Const = 0 %unless Iconst Item(R)                 {first variable}
      %if All Const # 0 %start                             {it's in VAL}
         Value_String = Tostring(R_Disp&255).Val           {don't forget the first}
         Z == Const String
         String Assign(Z, L)
         Release and Drop(Z)
         {all done, but fall through to drop descriptors}
      %else                                {some dynamic tostrings}
         Make AutoI(L, Bytes)
         Move Literal(Conc Length, L)      {move in the total length}
      %finish

         %routine Assign Part
            R_OpLink = 0
            Simple(R, L) %if All Const = 0
         %end

      Assign Part
      %cycle
         R == W
         W == R_Link
         Assign Part
         Release and Drop(R)
      %repeat %until W == Nil
      Release and Drop(L)
      %return
   %finish

      %routine Concat(%record(Stackfm)%name Source)
         %record(Stackfm)%name Dest
         Source_Oplink = 0
         %if Source_Type <= Addrs %start      {Tostring(X)}
            Dest == Register(R2);  Dest_Type = Bytes;  Dest_Form = AutoI
            Simple(Source, Dest)
            Release and Drop(Dest)
            %return
         %finish
         {perhaps optimise if source length known}
         Load Address(Source, R3)
         Prim(Sconc)
      %end

   LL == Copy(L);  Amap(LL)
   %if Same(L, R) %start                            {S = S.W.....}
      %if W_Link == Nil %and W_Type <= Addrs %start {S = S."*"}
         Loadup(LL);  LL_Type = Bytes;  LL_Form = Direct
         R == Copy(LL)                            {length pointer}
         Z == Copy(LL)
         Operate(ADDx, Z, Literal(1))             {length+1}
         Loadup(Z)                                {new length}
         LL_Index == Copy(Z);  LL_Xsize = 1       {charno descriptor}
         Simple(W, LL)                            {plug in character}
         Simple(Z, R)                             {plug in new length}
         Release and Drop Pair(W, Z)
         Release and Drop Pair(LL,R)
         %return
      %finish
      Load(LL, R2)                                {pointer to length}
      Z == Copy(LL);  Z_Type = Bytes;  Z_Form = AutoI
      Load(Z, R1)                                 {current length}
      R == Copy(LL);  Load(R, R0);  Drop(R)       {copy of @charno(s, 1)}
      LL_Index == Z;  LL_Xsize = 1
      Load(LL, R2);  Release(R2)                  {pointer past S}
      Forget(R2);  Activity(R2) = -1              {lock R2}
      LL_Base = R0                                {pointer for plugging length}
   %else
      DelayV == Nil
      %while R_Type <= Addrs %cycle               {pull of leading tostrings}
                                                  {NOTE - the case of all}
                                                  {tostrings handled above}
         Delay = Delay+1
         R_Oper = 0
         R_Link == DelayV;  DelayV == R           {reverse them}
         R == W
         W == W_Link
      %repeat
      Operate(ADDx, LL, Literal(Delay+1))         {onto first real char space}
      Load(LL, R2)
      Load(LL, R0)                                {copy for pluging length}
      Forget(R2);  Activity(R2) = -1              {lock R2}
      %if R ## Nil %start
         Concat(R)                                {first using Reg}
         Release(R_Base);  R_Base = 0
         Drop(R) %if Delay # 0
      %else
         Len = Delay                              {final length}
      %finish
   %finish
   %while W ## Nil %cycle
      R == W
      W == R_Link;  Concat(R)             {remainder using R2 set by MOVS}
      Release and Drop(R)                 {Note first is left to be released}
   %repeat                                {     by the caller}
   LL_Type = Bytes;  LL_Form = AutoD
   %while Delay # 0 %cycle
      Delay = Delay-1
      R == DelayV;  DelayV == R_Link;  R_Link == Nil
      Simple(R, LL)
      Release and Drop(R) %if Delay # 0
   %repeat
   %if Len = 0 %start                     {final length unknown}
      Plant1(SUB, R2, R2, Just(R0))
      Plant2(STR, R2, LL)
      Release and Drop(LL)
      LL == Copy(L);  LL_Type = Bytes
      Remember(R2, LL)
   %else                                  {final length known}
      Move Literal(Len, LL)               {plug the length directly}
   %finish
   Release and Drop(LL)
   Activity(R2) = 0                        {unlock R2}
%end
%endoffile