!Revision history:
!
! C-0087  20-Jul-88 PSR Changed register processing to fix R(r*r, r*r,..) bug
! 0.9  15-Jan-88 PSR Removed %namearray for transputer work

%record(Stackfm)%map Procedure Items(%record(Stackfm)%name R)
   {A procedure parameter is a pointer to a tw0-word vector}
   {There are four cases}
   {1. The procedure is an external  - <Ep><?>}
   {2. The procedure is a parameter  - pass the pointer}
   {3. The procedure is a safe local - pass <Ep><?> and mark the parameter}
   {                                   as needing an external entry}
   {4. The procedure is dangerous    - pass <Ep><Display> and work hard}
   %integer Mask
   %record(Stackfm)%name Ep, Env
   Env == NIL
   %if R_Flags&Xproc Spec # 0 %start      {case 1 - an external}
      Min SB = Min SB-4
      Ep == Local Integer(Min SB);  Ep_Base = SB
      Dir3(Dir xThunk, R_Disp, Ep_Disp)   {relocate entry pointer}
   %else %if R_Flags&Parameter # 0        {case 2 - already a parameter}
                                          {R defines <env><ep> pair}
      R_Type = Integers;  R_Form = Direct;  R_Area = 0
      Env == Copy(R)
      Ep == Copy(Env);  Advance(Ep, Integers, 4)
   %else
      %if R_Flags&XprocDef = 0 %and R_Flags&Nasty Proc # 0 %start
         {case 3 - not a dangerous internal}
         Env == Local Integer(Local Display);  Amap(Env)
      %finish
      Min SB = Min SB-4
      Ep == Local Integer(Min SB);  Ep_Base = SB
      Dir3(Dir Thunk, R_Disp, Ep_Disp)     {relocate entry pointer}
      Refs = Refs+1
   %finish
   Env == Literal(0) %if Env == NIL
   Env_Prim    = Integers;  Ep_Prim    = Integers
   Env_Params == Ep;        Ep_Params == NIL
   %result == Env
%end

%record(Stackfm)%map Arrayname Items(%record(Stackfm)%name Array)
   %record(Stackfm)%name DopeVector
   Array == Copy(Array)
   Array_Type = Integers          {the header contains integer addresses}
   %if Array_Flags&(Arrayname!Static) = 0 %start     {in a record}
      %if Array_Adata == Nil %start
         DopeVector == Literal(0)
      %else
         DopeVector == Literal(Array_Adata_DV)
         DopeVector_Area = Constant Area
      %finish
      Amap(Array)
   %else
      DopeVector == Copy(Array)
      Advance(DopeVector, Integers, Word Length)
   %finish
   Array_Prim    = Integers;    DopeVector_Prim    = Integers
   Array_Params == Dopevector;  Dopevector_Params == NIL
   %result == Array
%end

%record(Stackfm)%map Address Items(%record(Stackfm)%name Par, Formal)
   %record(Stackfm)%name W, X, Y, Z
   %integer Rt, Format
   %result == Procedure Items(Par) %if Formal_Form = Proc
   %result == Arrayname Items(Par) %if Formal_Flags&Arrayname # 0

   X == Copy(Par);  Amap(X);  X_Prim = Integers;  X_Params == NIL

   Format = Par_Format
   %if Formal_Type = Generals %start
      Rt = Par_Type
      %if Rt = Generals %start
                        Advance(X, Integers, 0)
         Y == Copy(X);  Advance(Y, Integers, Wordlength)
         Z == Copy(X);  Advance(Z, Integers, Wordlength*2)
      %else
         Z == Literal(Type Code(Rt))
         %if Rt = Strings %and X_Form = Direct %and Format = 1 %start {(*)}
            Y == Copy(X);  Advance(Y, Integers, Wordlength)
         %else
            Y == Literal(Item Size(Format))
         %finish
      %finish
                      Y_Prim    = Integers;  Z_Prim    = Integers
      X_Params == Y;  Y_Params == Z;         Z_Params == NIL
   %else %if Formal_Type = Strings %and Formal_Format = 1   {lhs string(*)name}
      %if Format = 1 %and X_Form # Address %start           {rhs string(*)name}
         Y == Copy(X);  Advance(Y, Integers, Wordlength)
      %else
         Y == Literal(Format)
      %finish
                      Y_Prim    = Integers
      X_Params == Y;  Y_Params == NIL
   %finish
   %result == X
%end

%routine Pass Parameters(%record(Stackfm)%name V, %integername Extra,
                         %integer BaseReg)
   %integer Completed
   %record(Stackfm)%name Par, Formal, Head, L
   %record(Stackfm)%name Items, Rest, X, Y
   %recordformat Rpfm(%record(Stackfm)%name P)
   %record(Rpfm)%array Reginfo(R0:R3)
   %ownrecord(Stackfm) Sp Mark                   {C-0087}

   Extra = 0
   Head == V_Params;  %return %if Head == NIL  {no parameters}

   {Head is the start of a list of actual parameters in reverse (R-L) order}
   {First, convert this into a forward list of integer, real & longreal items}

   Items == NIL
   %while Head ## Nil %cycle
      Par == Head;  Head == Head_Params
      Stack Var(Par_Varno);  Formal == Stack;  Stack == Formal_Stack
      %if Formal_Flags&Parameter # 0 %start       {procedure parameter}
         X == Procedure Items(Par)
      %else %if Formal_Flags&Arrayname # 0        {arrayname parameter}
         X == Arrayname Items(Par)
      %else %if Formal_Flags&Awanted # 0
         %if Par_Oper = CONCx %start
            Par == To Temp(Par, 256)
         %else %if Formal_Type = Strings %and Par_Type # Strings
            %if Iconst(Par) %then Fix Unitary String(Par) -
                            %else Par == To Temp(Par, 2)
         %else %if Par_Type = Strings %and Par_Bias = 1          {""}
            Fix Unitary String(Par)
         %else %if Par_Type = Sets
            %if Par_Oper # 0 %start
               Loadup(Par)
            %else %if Par_Members ## Nil
               Build Set(Par)
            %finish
         %finish
         X == Address Items(Par, Formal)
      %else
         X == Copy(Par)
         X_Prim    = Formal_Type
         X_Params == NIL
      %finish
      Release and Drop Pair(Par, Formal)
      Y == X;  Y == Y_Params %while Y_Params ## NIL
      Y_Params == Items
      Items == X
   %repeat

   %routine Complete Register Processing
      %integer R, N, Mask                           {C-0087}
      %record(Stackfm)%name V
      %return %if Completed # 0
      Completed = 1
      Monitor N(0, "+complete") %if Diag&MonOperand # 0

      {first, deal with the complex parameters}
      %for R = R0, 1, R3 %cycle
         V == Reginfo(R)_P
         %continue %if V == NIL %or V == Sp Mark  {C-0087}
         %if V_Oper # 0 %then Load(V, R) %else Simplify(V)
      %repeat

      {Now, load up all the free registers}

      %for R = R0, 1, R3 %cycle
         V == Reginfo(R)_P
         %continue %if V == NIL %or V == Sp Mark       {C-0087}
         Load(V, R) %if Activity(R) = 0 %and Ktimes(R) = 0
      %repeat

      {Now, load up the inactive registers}

      %for R = R0, 1, R3 %cycle
         V == Reginfo(R)_P
         %continue %if V == NIL %or V == Sp Mark       {C-0087}
         Load(V, R) %if Activity(R) = 0
      %repeat

      {last scan to make sure}

      N = 0
      %for R = R0, 1, R3 %cycle
         V == Reginfo(R)_P
         %continue %if V == NIL %or V == Sp Mark       {C-0087}
         Load(V, R)
         N = N+1        {one more active register}
      %repeat

      {Beware - once the registers have been loaded they are released}
      {If the HAZARD ALL in the CALL needs to use a register for     }
      {Addressing it may well corrupt one of the parameter registers }
      {Therefore do the hazarding here SCR???}

      %if Active Registers # N %start    {hazard pending registers}
         %for R = R0, 1, R3 %cycle
            V == Reginfo(R)_P
            Hazard(R) %if V == NIL %or V == Sp Mark
         %repeat
         Hazard(R4);  Hazard(R5);  Hazard(R6);  Hazard(R7)
         %if Active Registers # N %start
            Hazard(R8);  Hazard(R11);  Hazard(R14)
            %if Active Registers # N %start
               Hazard(F0);  Hazard(F1);  Hazard(F2);  Hazard(F3)
               %if Active Registers # N %start
                  Hazard(F4);  Hazard(F5);  Hazard(F6);  Hazard(F7)
               %finish
            %finish
         %finish
      %finish

      {now suck up any pushed values}             {C-0087}
      Mask = 0                                    {C-0087}
      N = 1                                       {C-0087}
      %for R = R0, 1, R3 %cycle                   {C-0087}
         %if Reginfo(R)_P == Sp Mark %start       {C-0087}
            Extra = Extra-4                       {C-0087}
            Mask = Mask ! N                       {C-0087}
         %finish                                  {C-0087}
         N = N<<1                                 {C-0087}
      %repeat                                     {C-0087}
      %if Mask # 0 %start                         {C-0087}
         Plant4(LDM ! IA ! Write Back, Sp, Mask)  {C-0087}
      %finish                                     {C-0087}

      {finally, get rid of everything}

      %for R = R0, 1, R3 %cycle
         V == Reginfo(R)_P
         %continue %if V == NIL %or V == Sp Mark
         Release and Drop(V)
      %repeat
      Monitor N(0, "+complete") %if Diag&MonOperand # 0
   %end

   %routine Push(%record(Stackfm)%name V, %integer Type)
      %record(Stackfm) Spv = 0
      Spv_Type = Type
      Spv_Form = AutoD
      Spv_Base = Sp
      %if Type = Integers %start
         Load(V, Any)
         Plant2(STR, V_Base, SpV)
      %else %if Type = Lreals
         Load(V, AnyF)
         Plant6(STFD, V_Base, SpV)
         Extra = Extra+4           {twice as big as integers & reals}
      %else %if Type = Reals
         Load(V, AnyF)
         Plant6(STFS, V_Base, SpV)
      %else
         Fail("Bad push type")
      %finish
      Extra = Extra+4
      Release and Drop(V)
   %end

!{C-0087}
!   %routine Pop(%integer Reg)
!      {reg < 0 is a flag for loading |reg| and |reg|+1}
!      %record(Stackfm)%name Spv
!      %if Reg >= 0 %start
!         Spv == Literal(0)
!         Spv_Form = AutoI
!         Spv_Base = Sp
!         Load(Spv, Reg)
!         Release and Drop(Spv)
!      %else
!         Reg = -Reg                                        {SCR???}
!         Hazard(Reg);  Hazard(Reg+1)                       {SCR???}
!         Plant4(LDM ! IA ! Write Back, Sp, 3<<Actual(Reg)) {SCR???}
!         Extra = Extra-4
!      %finish
!      Extra = Extra-4
!   %end
!{C-0087}

   %routine Process(%record(Stackfm)%name V, %integer Rn)
      %record(Stackfm)%name Next
      %return %if V == NIL           {no more parameters}
!     Monitor(V, "+ Process ".TypeId(V_Prim)) %if Diag&MonOperand # 0
      Next == V_Params

      %if Rn > R3 %start             {all registers dealt with}
         Process(Next, R4)           {deal with all the rest}
         Push(V, V_Prim)             {then push this one}
      %else %if V_Prim = Integers
         Reginfo(Rn)_P == V          {remember for later}
         Process(Next, Rn+1)         {deal with the rest}
      %else %if V_Prim = Reals
         Simplify(V)                 {better be safe}
         Load(V, AnyF) %if V_Type # Reals %and V_Type # Lreals
         {This one can go into a register, but it may need to use [Sp]}
         %if V_Form = Direct %start  {can go straight there}
            V_Type = Integers
            Reginfo(Rn)_P == V       {remember for later}
            Process(Next, Rn+1)      {deal with the rest first}
         %else                       {must go via [Sp]}
            Process(Next, Rn+1)      {deal with the rest first}
            Push(V, Reals)
            Reginfo(Rn)_P == Sp Mark        {C-0087}
!           Complete register processing    {C-0087}
!           Pop(Rn)                         {C-0087}
         %finish
      %else %if V_Prim = Lreals
         Simplify(V)                 {better be safe}
         Load(V, AnyF) %if V_Type # Lreals
         %if V_Form = Direct %start  {at least one bit can go in a register}
            %if Rn = R3 %start       {second half must be pushed}
               Process(Next, Rn+2)   {deal with the rest first}
               Push(V, Lreals)       {push both}
               Reginfo(Rn)_P == Sp Mark     {C-0087}
!              Complete register processing {C-0087}
!              Pop(R3)                      {C-0087} {and bring back R3}
            %else                    {second half fits into the next register}
               V_Type = Integers
               X == Copy(V);  Advance(X, Integers, 4)
               Reginfo(Rn+0)_P == V
               Reginfo(Rn+1)_P == X
               Process(Next, Rn+2)   {deal with the rest}
            %finish
         %else                       {must go via [Sp]}
            Process(Next, Rn+2)      {deal with the rest first}
            Push(V, Lreals)
            %if Rn = R3 %start       {one into register}   {C-0087}
               Reginfo(Rn+0)_P == Sp Mark                  {C-0087}
            %else                    {both into registers} {C-0087}
               Reginfo(Rn+0)_P == Sp Mark                  {C-0087}
               Reginfo(Rn+1)_P == Sp Mark                  {C-0087}
            %finish                                        {C-0087}
!           Complete register processing   {C-0087}
!           %if Rn = R3 %start             {C-0087} {pop one  into registers}
!              Pop(Rn)                     {C-0087}
!           %else                          {C-0087} {pop both into registers}
!              Pop(-Rn)                    {C-0087}
!           %finish                        {C-0087}
         %finish
      %else
         Fail("Bad process type")
      %finish
   %end

   Reginfo(R0)_P == NIL
   Reginfo(R1)_P == NIL
   Reginfo(R2)_P == NIL
   Reginfo(R3)_P == NIL
   Completed = 0
   Process(Items, BaseReg)
   Complete register processing
%end