(* M2ALU.def gcc implementation of the M2ALU module.

Copyright (C) 2001-2023 Free Software Foundation, Inc.
Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.

This file is part of GNU Modula-2.

GNU Modula-2 is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 3, or (at your option)
any later version.

GNU Modula-2 is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Modula-2; see the file COPYING3.  If not see
<http://www.gnu.org/licenses/>.  *)

DEFINITION MODULE M2ALU ;

(*
    Title      : M2ALU.def
    Author     : Gaius Mulley
    System     : UNIX (gm2)
    Date       : Tue Jul 11 09:14:28 2000
    Description: Handles all values in the Modula-2 compiler and all
                 manipulations of values. All values are mapped onto
                 gcc trees.
*)

FROM NameKey IMPORT Name ;
FROM m2tree IMPORT Tree ;
FROM M2GCCDeclare IMPORT WalkAction, IsAction ;

EXPORT QUALIFIED PtrToValue,
                 InitValue,
                 IsValueTypeNone,
                 IsValueTypeInteger,
                 IsValueTypeReal,
                 IsValueTypeComplex,
                 IsValueTypeSet,
                 IsValueTypeConstructor,
                 IsValueTypeArray,
                 IsValueTypeRecord,
                 PopInto, PushFrom,
                 PushIntegerTree, PopIntegerTree,
                 PushSetTree, PopSetTree,
                 PushRealTree, PopRealTree,
                 PushComplexTree, PopComplexTree,
                 PopConstructorTree,
                 PopChar,
                 PushCard,
                 PushInt,
                 PushChar,
                 PushString,
                 PushTypeOfTree,
                 CoerseLongRealToCard,
                 ConvertRealToInt,
                 ConvertToInt,
                 ConvertToType,
                 GetSetValueType,
                 IsSolved, IsValueConst,
                 PutConstructorSolved, EvaluateValue, TryEvaluateValue,

                 IsNulSet, IsGenericNulSet, PushNulSet, AddBitRange, AddBit, SubBit,
      	       	 SetOr, SetAnd, SetIn,
                 SetDifference, SetSymmetricDifference,
                 SetNegate, SetShift, SetRotate,

                 Addn, Multn, Sub,
                 DivFloor, ModFloor, DivTrunc, ModTrunc,
                 Equ, NotEqu, Less, Gre, LessEqu, GreEqu,
                 GetValue, GetRange,  ConstructSetConstant, BuildRange,
                 IsConstructorDependants, WalkConstructorDependants,
                 AddField, AddElements,

                 PushEmptyConstructor, PushEmptyArray, PushEmptyRecord,
                 ChangeToConstructor,

                 IsValueAndTreeKnown, CheckOrResetOverflow ;

TYPE
   PtrToValue ;


(*
   InitValue - initializes and returns a value container.
*)

PROCEDURE InitValue () : PtrToValue ;


(*
   IsValueTypeNone - returns TRUE if the value on the top stack has no value.
*)

PROCEDURE IsValueTypeNone () : BOOLEAN ;


(*
   IsValueTypeInteger - returns TRUE if the value on the top stack is an integer.
*)

PROCEDURE IsValueTypeInteger () : BOOLEAN ;


(*
   IsValueTypeReal - returns TRUE if the value on the top stack is a real.
*)

PROCEDURE IsValueTypeReal () : BOOLEAN ;


(*
   IsValueTypeComplex - returns TRUE if the value on the top stack is a complex.
*)

PROCEDURE IsValueTypeComplex () : BOOLEAN ;


(*
   IsValueTypeSet - returns TRUE if the value on the top stack is a set.
*)

PROCEDURE IsValueTypeSet () : BOOLEAN ;


(*
   IsValueTypeConstructor - returns TRUE if the value on the top
                            stack is a constructor.
*)

PROCEDURE IsValueTypeConstructor () : BOOLEAN ;


(*
   IsValueTypeArray - returns TRUE if the value on the top
                      stack is an array.
*)

PROCEDURE IsValueTypeArray () : BOOLEAN ;


(*
   IsValueTypeRecord - returns TRUE if the value on the top
                       stack is a record.
*)

PROCEDURE IsValueTypeRecord () : BOOLEAN ;


(*
   GetSetValueType - returns the set type on top of the ALU stack.
*)

PROCEDURE GetSetValueType () : CARDINAL ;


(*
   PushIntegerTree - pushes a gcc tree value onto the ALU stack.
*)

PROCEDURE PushIntegerTree (t: Tree) ;


(*
   PopIntegerTree - pops a gcc tree value from the ALU stack.
*)

PROCEDURE PopIntegerTree () : Tree ;


(*
   PushRealTree - pushes a gcc tree value onto the ALU stack.
*)

PROCEDURE PushRealTree (t: Tree) ;


(*
   PopRealTree - pops a gcc tree value from the ALU stack.
*)

PROCEDURE PopRealTree () : Tree ;


(*
   PushComplexTree - pushes a gcc tree value onto the ALU stack.
*)

PROCEDURE PushComplexTree (t: Tree) ;


(*
   PopComplexTree - pops a gcc tree value from the ALU stack.
*)

PROCEDURE PopComplexTree () : Tree ;


(*
   PushSetTree - pushes a gcc tree onto the ALU stack.
                 The tree, t, is expected to contain a
                 word value. It is converted into a set
                 type (sym). Bit 0 maps onto MIN(sym).
*)

PROCEDURE PushSetTree (tokenno: CARDINAL;
                       t: Tree; sym: CARDINAL) ;


(*
   PopSetTree - pops a gcc tree from the ALU stack.
*)

PROCEDURE PopSetTree (tokenno: CARDINAL) : Tree ;


(*
   PopConstructorTree - returns a tree containing the compound literal.
*)

PROCEDURE PopConstructorTree (tokenno: CARDINAL) : Tree ;


(*
   PushFrom - pushes a copy of the contents of, v, onto stack.
*)

PROCEDURE PushFrom (v: PtrToValue) ;


(*
   PopInto - pops the top element from the stack and places it into, v.
*)

PROCEDURE PopInto (v: PtrToValue) ;


(*
   PushCard - pushes a cardinal onto the stack.
*)

PROCEDURE PushCard (c: CARDINAL) ;


(*
   PushInt - pushes an integer onto the stack.
*)

PROCEDURE PushInt (i: INTEGER) ;


(*
   PushChar - pushes a char onto the stack.
*)

PROCEDURE PushChar (c: CHAR) ;


(*
   PopChar - returns the value from the stack in a character.
*)

PROCEDURE PopChar (tokenno: CARDINAL) : CHAR ;


(*
   PushString - pushes the numerical value of the string onto the stack.
*)

PROCEDURE PushString (tokenno: CARDINAL; s: Name; issueError: BOOLEAN) ;


(*
   CoerseLongRealToCard - performs a coersion between a REAL to a CARDINAL
*)

PROCEDURE CoerseLongRealToCard ;


(*
   ConvertRealToInt - converts a REAL into an INTEGER
*)

PROCEDURE ConvertRealToInt ;


(*
   ConvertToInt - converts the value into an INTEGER. This should be used
                  if we are computing the number of elements in a char set to
                  avoid an overflow.
*)

PROCEDURE ConvertToInt ;


(*
   ConvertToType - converts the top of stack to type, t.
*)

PROCEDURE ConvertToType (t: CARDINAL) ;


(*
   IsSolved - returns true if the memory cell indicated by v
              has a known value.
*)

PROCEDURE IsSolved (v: PtrToValue) : BOOLEAN ;


(*
   PutConstructorSolved - records that this constructor is solved.
*)

PROCEDURE PutConstructorSolved (sym: CARDINAL) ;


(*
   EvaluateValue - attempts to evaluate the symbol, sym, value.
*)

PROCEDURE EvaluateValue (sym: CARDINAL) ;


(*
   TryEvaluateValue - attempts to evaluate the symbol, sym, value.
*)

PROCEDURE TryEvaluateValue (sym: CARDINAL) ;


(*
   Add - adds the top two elements on the stack.

         The Stack:

         Entry             Exit

  Ptr ->
         +------------+
         | Op1        |                   <- Ptr
         |------------|    +------------+
         | Op2        |    | Op2 + Op1  |
         |------------|    |------------|
*)

PROCEDURE Addn ;


(*
   Sub - subtracts the top two elements on the stack.

         The Stack:

         Entry             Exit

  Ptr ->
         +------------+
         | Op1        |                   <- Ptr
         |------------|    +------------+
         | Op2        |    | Op2 - Op1  |
         |------------|    |------------|
*)

PROCEDURE Sub ;


(*
   Mult - multiplies the top two elements on the stack.

          The Stack:

          Entry             Exit

   Ptr ->
          +------------+
          | Op1        |                   <- Ptr
          |------------|    +------------+
          | Op2        |    | Op2 * Op1  |
          |------------|    |------------|
*)

PROCEDURE Multn ;


(*
   DivFloor - divides the top two elements on the stack.

              The Stack:

              Entry             Exit

       Ptr ->
              +------------+
              | Op1        |                     <- Ptr
              |------------|    +--------------+
              | Op2        |    | Op2 DIV Op1  |
              |------------|    |--------------|
*)

PROCEDURE DivFloor ;


(*
   ModFloor - modulus of the top two elements on the stack.

              The Stack:

              Entry             Exit

       Ptr ->
              +------------+
              | Op1        |                     <- Ptr
              |------------|    +--------------+
              | Op2        |    | Op2 MOD Op1  |
              |------------|    |--------------|
*)

PROCEDURE ModFloor ;


(*
   DivTrunc - divides the top two elements on the stack.

              The Stack:

              Entry             Exit

       Ptr ->
              +------------+
              | Op1        |                     <- Ptr
              |------------|    +--------------+
              | Op2        |    | Op2 DIV Op1  |
              |------------|    |--------------|
*)

PROCEDURE DivTrunc ;


(*
   ModTrunc - modulus of the top two elements on the stack.

              The Stack:

              Entry             Exit

       Ptr ->
              +------------+
              | Op1        |                     <- Ptr
              |------------|    +--------------+
              | Op2        |    | Op2 MOD Op1  |
              |------------|    |--------------|
*)

PROCEDURE ModTrunc ;


(*
   Equ - returns true if the top two elements on the stack
         are identical.

         The Stack:

         Entry             Exit

  Ptr ->
         +------------+
         | Op1        |
         |------------|
         | Op2        |
         |------------|    Empty

         RETURN( Op2 = Op1 )
*)

PROCEDURE Equ (tokenno: CARDINAL) : BOOLEAN ;


(*
   NotEqu - returns true if the top two elements on the stack
            are not identical.

            The Stack:

            Entry             Exit

     Ptr ->
            +------------+
            | Op1        |
            |------------|
            | Op2        |
            |------------|    Empty

            RETURN( Op2 # Op1 )
*)

PROCEDURE NotEqu (tokenno: CARDINAL) : BOOLEAN ;


(*
   Less - returns true if Op2 < Op1.

          The Stack:

          Entry             Exit

   Ptr ->
          +------------+
          | Op1        |
          |------------|
          | Op2        |
          |------------|    Empty

          RETURN( Op2 < Op1 )
*)

PROCEDURE Less (tokenno: CARDINAL) : BOOLEAN ;


(*
   Gre - returns true if Op2 > Op1

         The Stack:

         Entry             Exit

  Ptr ->
         +------------+
         | Op1        |
         |------------|
         | Op2        |
         |------------|    Empty

         RETURN( Op2 > Op1 )
*)

PROCEDURE Gre (tokenno: CARDINAL) : BOOLEAN ;


(*
   LessEqu - returns true if Op2 <= Op1

            The Stack:

            Entry             Exit

     Ptr ->
            +------------+
            | Op1        |
            |------------|
            | Op2        |
            |------------|    Empty

            RETURN( Op2 <= Op1 )
*)

PROCEDURE LessEqu (tokenno: CARDINAL) : BOOLEAN ;


(*
   GreEqu - returns true if Op2 >= Op1
            are not identical.

            The Stack:

            Entry             Exit

     Ptr ->
            +------------+
            | Op1        |
            |------------|
            | Op2        |
            |------------|    Empty

            RETURN( Op2 >= Op1 )
*)

PROCEDURE GreEqu (tokenno: CARDINAL) : BOOLEAN ;


(*
   IsNulSet - returns TRUE if the top element is the nul set constant, {}.
*)

PROCEDURE IsNulSet () : BOOLEAN ;


(*
   IsGenericNulSet - returns TRUE if the top element is the generic nul set constant, {}.
*)

PROCEDURE IsGenericNulSet () : BOOLEAN ;


(*
   PushNulSet - pushes an empty set {} onto the ALU stack. The subrange type used
                to construct the set is defined by, type. If this is NulSym then
                the set is generic and compatible with all sets.

                The Stack:

                Entry             Exit

                                                 <- Ptr
                                  +------------+
                                  | {}         |
                Ptr ->            |------------|

*)

PROCEDURE PushNulSet (settype: CARDINAL) ;


(*
   AddBitRange - adds the range op1..op2 to the underlying set.

                 Ptr ->
                                                           <- Ptr
                        +------------+      +------------+
                        | Set        |      | Set        |
                        |------------|      |------------|
*)

PROCEDURE AddBitRange (tokenno: CARDINAL; op1, op2: CARDINAL) ;


(*
   AddBit - adds the bit op1 to the underlying set. INCL(Set, op1)

            Ptr ->
                                                      <- Ptr
                   +------------+      +------------+
                   | Set        |      | Set        |
                   |------------|      |------------|
*)

PROCEDURE AddBit (tokenno: CARDINAL; op1: CARDINAL) ;


(*
   SubBit - removes a bit op1 from the underlying set. EXCL(Set, Op1)

            Ptr ->
                   +------------+
                   | Op1        |                     <- Ptr
                   |------------|      +------------+
                   | Set        |      | Set        |
                   |------------|      |------------|
*)

PROCEDURE SubBit (tokenno: CARDINAL; op1: CARDINAL) ;


(*
   SetIn - returns true if the Op1 IN Set

           The Stack:

           Entry             Exit

    Ptr ->
           +------------+
           | Set        |
           |------------|
           | Op1        |
           |------------|    Empty

           RETURN( Op1 IN Set )
*)

PROCEDURE SetIn (tokenno: CARDINAL; Op1: CARDINAL) : BOOLEAN ;


(*
   SetOr -  performs an inclusive OR of the top two sets on the stack.

            The Stack:

            Entry             Exit

     Ptr ->
            +------------+
            | Op1        |                   <- Ptr
            |------------|    +------------+
            | Op2        |    | Op2 + Op1  |
            |------------|    |------------|

*)

PROCEDURE SetOr (tokenno: CARDINAL) ;


(*
   SetAnd - performs a set AND the top two sets on the stack.

            The Stack:

            Entry             Exit

     Ptr ->
            +------------+
            | Op1        |                   <- Ptr
            |------------|    +------------+
            | Op2        |    | Op2 * Op1  |
            |------------|    |------------|
*)

PROCEDURE SetAnd (tokenno: CARDINAL) ;


(*
   SetDifference - performs a set difference of the top two elements on the stack.
                   For each member in the set
                      if member in Op2 and not member in Op1

                   The Stack:

                   Entry             Exit

            Ptr ->
                   +------------+
                   | Op1        |                   <- Ptr
                   |------------|    +-------------------+
                   | Op2        |    | Op2 and (not Op1) |
                   |------------|    |-------------------|
*)

PROCEDURE SetDifference (tokenno: CARDINAL) ;


(*
   SetSymmetricDifference - performs a set difference of the top two sets on the stack.

                            The Stack:

                            Entry             Exit

                     Ptr ->
                            +------------+
                            | Op1        |                   <- Ptr
                            |------------|    +------------+
                            | Op2        |    | Op2 - Op1  |
                            |------------|    |------------|
*)

PROCEDURE SetSymmetricDifference (tokenno: CARDINAL) ;


(*
   SetNegate - negates the top set on the stack.

               Ptr ->                                               <- Ptr
                      +-----------+                  +------------+
                      | Set       |                  | Set        |
                      |-----------|                  |------------|
*)

PROCEDURE SetNegate (tokenno: CARDINAL) ;


(*
   SetShift - if op1 is positive
              then
                 result := op2 << op1
              else
                 result := op2 >> op1
              fi


              The Stack:

                     Entry             Exit

              Ptr ->
                     +------------+
                     | Op1        |                   <- Ptr
                     |------------|    +------------+
                     | Op2        |    | result     |
                     |------------|    |------------|

*)

PROCEDURE SetShift (tokenno: CARDINAL) ;


(*
   SetRotate - if op1 is positive
               then
                  result := ROTATERIGHT(op2, op1)
               else
                  result := ROTATELEFT(op2, op1)
               fi


               The Stack:

                      Entry             Exit

               Ptr ->
                      +------------+
                      | Op1        |                   <- Ptr
                      |------------|    +------------+
                      | Op2        |    | result     |
                      |------------|    |------------|
*)

PROCEDURE SetRotate (tokenno: CARDINAL) ;


(*
   GetValue - returns and pops the value from the top of stack.
*)

PROCEDURE GetValue (tokenno: CARDINAL) : PtrToValue ;


(*
   GetRange - returns TRUE if range number, n, exists in the value, v.
              A non empty set is defined by having 1..N ranges
*)

PROCEDURE GetRange (v: PtrToValue; n: CARDINAL; VAR low, high: CARDINAL) : BOOLEAN ;


(*
   ConstructSetConstant - builds a struct of integers which represents the
                          set const, sym.
*)

PROCEDURE ConstructSetConstant (tokenno: CARDINAL; v: PtrToValue) : Tree ;


(*
   BuildRange - returns a integer sized constant which represents the
                value  {e1..e2}.
*)

PROCEDURE BuildRange (tokenno: CARDINAL; e1, e2: Tree) : Tree ;


(*
   IsConstructorDependants - return TRUE if returned if all
                             q(dependants) of, sym, return TRUE.
*)

PROCEDURE IsConstructorDependants (sym: CARDINAL; q: IsAction) : BOOLEAN ;


(*
   WalkConstructorDependants - walk the constructor, sym, calling
                               p for each dependant.
*)

PROCEDURE WalkConstructorDependants (sym: CARDINAL; p: WalkAction) ;


(*
   IsValueAndTreeKnown - returns TRUE if the value is known and the gcc tree
                         is defined.

                         The Stack:

                                Entry             Exit

                         Ptr ->
                                +------------+
                                | Op1        |                   <- Ptr
                                |------------|    +------------+
*)

PROCEDURE IsValueAndTreeKnown () : BOOLEAN ;


(*
   CheckOrResetOverflow - tests to see whether the tree, t, has caused
                          an overflow error and if so it generates an
                          error message.
*)

PROCEDURE CheckOrResetOverflow (tokenno: CARDINAL; t: Tree; check: BOOLEAN) ;


(*
   AddElements - adds the elements, el BY, n, to the array constant.

                 Ptr ->
                                                           <- Ptr
                        +------------+      +------------+
                        | Array      |      | Array      |
                        |------------|      |------------|

*)

PROCEDURE AddElements (tokenno: CARDINAL; el, n: CARDINAL) ;


(*
   AddField - adds the field op1 to the underlying constructor.

              Ptr ->
                                                        <- Ptr
                     +------------+      +------------+
                     | const      |      | const      |
                     |------------|      |------------|

*)

PROCEDURE AddField (tokenno: CARDINAL; op1: CARDINAL) ;


(*
   PushEmptyConstructor - pushes an empty constructor {} onto the ALU stack.
                          This is expected to be filled in by subsequent
                          calls to AddElements, AddRange or AddField.

                          The Stack:

                          Entry             Exit

                                                       <- Ptr
                                        +------------+
                                        | {}         |
                   Ptr ->               |------------|

*)

PROCEDURE PushEmptyConstructor (constype: CARDINAL) ;


(*
   PushEmptyArray - pushes an empty array {} onto the ALU stack.
                    This is expected to be filled in by subsequent
                    calls to AddElements.

                    The Stack:

                    Entry             Exit

                                                     <- Ptr
                                      +------------+
                                      | {}         |
             Ptr ->                   |------------|

*)

PROCEDURE PushEmptyArray (arraytype: CARDINAL) ;


(*
   PushEmptyRecord - pushes an empty record {} onto the ALU stack.
                     This is expected to be filled in by subsequent
                     calls to AddField.

                     The Stack:

                     Entry             Exit

                                                      <- Ptr
                                       +------------+
                                       | {}         |
              Ptr ->                   |------------|

*)

PROCEDURE PushEmptyRecord (recordtype: CARDINAL) ;


(*
   ChangeToConstructor - change the top of stack value to a constructor, type.
*)

PROCEDURE ChangeToConstructor (tokenno: CARDINAL; constype: CARDINAL) ;


(*
   IsValueConst - returns true if the memory cell indicated by v
                  is only defined by constants.  For example
                  no variables are used in the constructor.
*)

PROCEDURE IsValueConst (v: PtrToValue) : BOOLEAN ;


(*
   PushTypeOfTree - pushes tree, gcc, to the stack and records the
                    front end type.
*)

PROCEDURE PushTypeOfTree (sym: CARDINAL; gcc: Tree) ;


END M2ALU.