public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
* [PATCH] Modula-2: merge proposal/review: 6/9 06.patch-set-04-3
@ 2022-05-18 13:45 Gaius Mulley
  0 siblings, 0 replies; only message in thread
From: Gaius Mulley @ 2022-05-18 13:45 UTC (permalink / raw)
  To: gcc-patches

Hello,

this email contains:

4.  the glue code (between Modula-2 and GCC) part 3/3.
    (*.def files).


------------------------
New file: gcc/m2/gm2-gcc/README
------------------------
This directory contains the interface code between the Modula-2 front
end and GCC.  In effect this is the Modula-2 compiler GCC Tree API.
It is an internal API only.  Many of these filenames match their GCC C
family counterparts.  So for example m2decl.def and m2decl.c are the
Modula-2 front end version of c-decl.c.
------------------------
New file: gcc/m2/gm2-gcc/m2type.def
------------------------
(* m2type.def definition module for m2type.cc.

Copyright (C) 2011-2022 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 m2type ;

FROM SYSTEM IMPORT ADDRESS ;
FROM m2tree IMPORT Tree ;
FROM m2linemap IMPORT location_t ;


TYPE
   Constructor = ADDRESS ;


(*
   ValueInTypeRange - returns TRUE if the constant, value, lies in the range
                      of, type.
*)

PROCEDURE ValueInTypeRange (type: Tree; value: Tree) : BOOLEAN ;


(*
   ValueOutOfTypeRange - returns TRUE if the constant, value, exceed the range
                         of, type.
*)

PROCEDURE ValueOutOfTypeRange (type: Tree; value: Tree) : BOOLEAN ;


(*
   ExceedsTypeRange - return TRUE if low or high exceed the range of, type.
*)

PROCEDURE ExceedsTypeRange (type: Tree; low, high: Tree) : BOOLEAN ;


(*
   WithinTypeRange - return TRUE if low and high are within the range of, type.
*)

PROCEDURE WithinTypeRange (type: Tree; low, high: Tree) : BOOLEAN ;


(*
    BuildSubrangeType - creates a subrange of, type, with, lowval, highval.
*)

PROCEDURE BuildSubrangeType (location: location_t; name: ADDRESS; type: Tree; lowval: Tree; highval: Tree) : Tree ;


(*
    BuildCharConstant - creates a character constant given a, string.
*)

PROCEDURE BuildCharConstant (location: location_t; string: ADDRESS) : Tree ;


(*
   BuildCharConstantChar - creates a character constant given a character, ch.
*)

PROCEDURE BuildCharConstantChar (location: location_t; ch: CHAR) : Tree ;


(*
    BuildArrayConstructorElement - adds, value, to the constructor_element_list.
*)

PROCEDURE BuildArrayConstructorElement (p: ADDRESS; value: Tree; indice: Tree) ;


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

PROCEDURE BuildEndArrayConstructor (p: Constructor) : Tree ;


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

PROCEDURE BuildStartArrayConstructor (type: Tree) : Constructor ;


(*
    BuildRecordConstructorElement - adds, value, to the constructor_element_list.
*)

PROCEDURE BuildRecordConstructorElement (p: Constructor; value: Tree) ;


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

PROCEDURE BuildEndRecordConstructor (p: Constructor) : Tree ;


(*
   BuildStartRecordConstructor - initializes a record compound
                                 constructor frame.
*)

PROCEDURE BuildStartRecordConstructor (type: Tree) : Constructor ;


(*
    BuildEndSetConstructor - finishes building a set constant.
*)

PROCEDURE BuildEndSetConstructor (p: Constructor) : Tree ;


(*
    BuildSetConstructorElement - adds, value, to the constructor_element_list.
*)

PROCEDURE BuildSetConstructorElement (p: Constructor; value: Tree) ;


(*
   BuildStartSetConstructor - starts to create a set constant.
                              Remember that type is really a record type.
*)

PROCEDURE BuildStartSetConstructor (type: Tree) : Constructor ;


(*
    BuildSetType - creates a SET OF [lowval..highval]
*)

PROCEDURE BuildSetType (location: location_t; name: ADDRESS; type: Tree; lowval: Tree; highval: Tree; ispacked: BOOLEAN) : Tree ;


(*
    BuildConstPointerType - returns a type which is a const pointer to, totype.
*)

PROCEDURE BuildConstPointerType (totype: Tree) : Tree ;


(*
    BuildPointerType - returns a type which is a pointer to, totype.
*)

PROCEDURE BuildPointerType (totype: Tree) : Tree ;


(*
    BuildEnumerator - build an enumerator and add it to the, enumvalues, list.
                      It returns a copy of the value.  --fixme-- why do this?
*)

PROCEDURE BuildEnumerator (location: location_t; name: ADDRESS; value: Tree;
                           VAR enumvalues: Tree) : Tree ;


(*
    BuildEndEnumeration - finish building the enumeration, it uses the enum
                          list, enumvalues, and returns a enumeration type tree.
*)

PROCEDURE BuildEndEnumeration (location: location_t; type: Tree; enumvalues: Tree) : Tree ;


(*
    BuildStartEnumeration - create an enumerated type in gcc.
*)

PROCEDURE BuildStartEnumeration (location: location_t; name: ADDRESS; ispacked: BOOLEAN) : Tree ;


(*
    BuildTypeDeclaration - adds the, type, to the current statement list.
*)

PROCEDURE BuildTypeDeclaration (location: location_t; type: Tree) ;


(*
    GetMaxFrom - given a, type, return a constant representing the maximum
                 legal value.
*)

PROCEDURE GetMaxFrom (location: location_t; type: Tree) : Tree ;


(*
    GetMinFrom - given a, type, return a constant representing the minimum
                 legal value.
*)

PROCEDURE GetMinFrom (location: location_t; type: Tree) : Tree ;


(*
    GetDefaultType - given a, type, with a, name, return a GCC declaration of this type.
                     Checks to see whether the type name has already been declared as a
                     default type and if so it returns this declaration. Otherwise it
                     declares the type. In Modula-2 this is equivalent to:

                     TYPE
                        name = type ;

                     We need this function as the initialization to gccgm2.c will
                     declare C default types and _some_ M2 default types.
*)

PROCEDURE GetDefaultType (location: location_t; name: ADDRESS; type: Tree) : Tree ;


(*
    BuildEndType - finish declaring, type, and return, type.
*)

PROCEDURE BuildEndType (location: location_t; type: Tree) : Tree ;


(*
    BuildStartType - given a, type, with a, name, return a GCC declaration of this type.
                     TYPE
                        name = foo ;

                     the type, foo, maybe a partially created type (which has
                     yet to be 'gm2_finish_decl'ed.
*)

PROCEDURE BuildStartType (location: location_t; name: ADDRESS; type: Tree) : Tree ;


(*
   InitSystemTypes -
*)

PROCEDURE InitSystemTypes (location: location_t; loc: INTEGER) ;


(*
   InitBaseTypes -
*)

PROCEDURE InitBaseTypes (location: location_t) ;


(*
    BuildVariableArrayAndDeclare - creates a variable length array.
                                   high is the maximum legal elements (which is a runtime variable).
                                   This creates and array index, array type and local variable.
*)

PROCEDURE BuildVariableArrayAndDeclare (location: location_t; elementtype: Tree; high: Tree; name: ADDRESS; scope: Tree) : Tree ;


(*
    InitFunctionTypeParameters - resets the current function type parameter list.
*)

PROCEDURE InitFunctionTypeParameters ;


(*
   BuildProcTypeParameterDeclaration - creates and returns one parameter from, name, and, type.
                                       It appends this parameter to the internal param_type_list.
*)

PROCEDURE BuildProcTypeParameterDeclaration (location: location_t; type: Tree; isreference: BOOLEAN) : Tree ;


(*
    BuildStartFunctionType - creates a pointer type, necessary to
                             create a function type.
*)

PROCEDURE BuildStartFunctionType (location: location_t; name: ADDRESS) : Tree ;


(*
    BuildEndFunctionType - build a function type which would return a, value.
                           The arguments have been created by BuildParameterDeclaration.
*)

PROCEDURE BuildEndFunctionType (func: Tree; type: Tree; usesvarags: BOOLEAN) : Tree ;


(*
    GetTreeType - returns TREE_TYPE (t).
*)

PROCEDURE GetTreeType (type: Tree) : Tree ;


(*
    DeclareKnownType - given a, type, with a, name, return a GCC declaration of this type.
                       TYPE
                          name = foo ;
*)

PROCEDURE DeclareKnownType (location: location_t; name: ADDRESS; type: Tree) : Tree ;


(*
    GetM2ZType - return the ISO Z data type, the longest int datatype.
*)

PROCEDURE GetM2ZType () : Tree ;


(*
    GetM2RType - return the ISO R data type, the longest real datatype.
*)

PROCEDURE GetM2RType () : Tree ;


(*
    BuildSetTypeFromSubrange - constructs a set type from a subrangeType.
*)

PROCEDURE BuildSetTypeFromSubrange (location: location_t; name: ADDRESS;
                                    subrangeType: Tree;
                                    lowval: Tree; highval: Tree;
                                    ispacked: BOOLEAN) : Tree ;


(*
    BuildSmallestTypeRange - returns the smallest INTEGER_TYPE which is
                             sufficient to contain values: low..high.
*)

PROCEDURE BuildSmallestTypeRange (location: location_t; low: Tree; high: Tree) : Tree ;


(*
    GetBooleanType -
*)

PROCEDURE GetBooleanType () : Tree ;


(*
    GetBooleanFalse -
*)

PROCEDURE GetBooleanFalse () : Tree ;


(*
    GetBooleanTrue -
*)

PROCEDURE GetBooleanTrue () : Tree ;


(*
    GetPackedBooleanType - return the packed boolean data type node.
*)

PROCEDURE GetPackedBooleanType () : Tree ;


(*
    GetCharType - return the char type node.
*)

PROCEDURE GetCharType () : Tree ;


(*
    GetByteType - return the byte type node.
*)

PROCEDURE GetByteType () : Tree ;


(*
    GetVoidType - return the C void type.
*)

PROCEDURE GetVoidType () : Tree ;


(*
    GetBitnumType - return the ISO bitnum type.
*)

PROCEDURE GetBitnumType () : Tree ;


(*
    GetRealType -
*)

PROCEDURE GetRealType () : Tree ;


(*
    GetLongRealType - return the C long double data type.
*)

PROCEDURE GetLongRealType () : Tree ;


(*
    GetShortRealType - return the C float data type.
*)

PROCEDURE GetShortRealType () : Tree ;


(*
    GetLongIntType - return the C long int data type.
*)

PROCEDURE GetLongIntType () : Tree ;


(*
    GetPointerType - return the GCC ptr type node.  Equivalent to (void * ).
*)

PROCEDURE GetPointerType () : Tree ;


(*
    GetCardinalType - return the cardinal type.
*)

PROCEDURE GetCardinalType () : Tree ;


(*
    GetIntegerType - return the integer type node.
*)

PROCEDURE GetIntegerType () : Tree ;


(*
    GetWordType - return the C unsigned data type.
*)

PROCEDURE GetWordType () : Tree ;


(*
    GetM2CardinalType - return the m2 cardinal data type.
*)

PROCEDURE GetM2CardinalType () : Tree ;


(*
    GetBitsetType - return the bitset type.
*)

PROCEDURE GetBitsetType () : Tree ;


(*
    GetM2CType - a test function.
*)

PROCEDURE GetM2CType () : Tree ;


(*
    GetProcType - return the m2 proc data type.
*)

PROCEDURE GetProcType () : Tree ;


(*
    GetM2ComplexType - return the complex type.
*)

PROCEDURE GetM2ComplexType () : Tree ;


(*
    GetM2LongComplexType - return the long complex type.
*)

PROCEDURE GetM2LongComplexType () : Tree ;


(*
    GetM2ShortComplexType - return the short complex type.
*)

PROCEDURE GetM2ShortComplexType () : Tree ;


(*
    GetM2Complex128Type - return the fixed size complex type.
*)

PROCEDURE GetM2Complex128 () : Tree ;


(*
    GetM2Complex96 - return the fixed size complex type.
*)

PROCEDURE GetM2Complex96 () : Tree ;


(*
    GetM2Complex64 - return the fixed size complex type.
*)

PROCEDURE GetM2Complex64 () : Tree ;


(*
    GetM2Complex32 - return the fixed size complex type.
*)

PROCEDURE GetM2Complex32 () : Tree ;


(*
    GetM2Real128 - return the real 128 bit type.
*)

PROCEDURE GetM2Real128 () : Tree ;


(*
    GetM2Real96 - return the real 96 bit type.
*)

PROCEDURE GetM2Real96 () : Tree ;


(*
    GetM2Real64 - return the real 64 bit type.
*)

PROCEDURE GetM2Real64 () : Tree ;


(*
    GetM2Real32 - return the real 32 bit type.
*)

PROCEDURE GetM2Real32 () : Tree ;


(*
    GetM2Bitset32 - return the bitset 32 bit type.
*)

PROCEDURE GetM2Bitset32 () : Tree ;


(*
    GetM2Bitset16 - return the bitset 16 bit type.
*)

PROCEDURE GetM2Bitset16 () : Tree ;


(*
    GetM2Bitset8 - return the bitset 8 bit type.
*)

PROCEDURE GetM2Bitset8 () : Tree ;


(*
    GetM2Word64 - return the word 64 bit type.
*)

PROCEDURE GetM2Word64 () : Tree ;


(*
    GetM2Word32 - return the word 32 bit type.
*)

PROCEDURE GetM2Word32 () : Tree ;


(*
    GetM2Word16 - return the word 16 bit type.
*)

PROCEDURE GetM2Word16 () : Tree ;


(*
    GetM2Cardinal64 - return the cardinal 64 bit type.
*)

PROCEDURE GetM2Cardinal64 () : Tree ;


(*
    GetM2Cardinal32 - return the cardinal 32 bit type.
*)

PROCEDURE GetM2Cardinal32 () : Tree ;


(*
    GetM2Cardinal16 - return the cardinal 16 bit type.
*)

PROCEDURE GetM2Cardinal16 () : Tree ;


(*
    GetM2Cardinal8 - return the cardinal 8 bit type.
*)

PROCEDURE GetM2Cardinal8 () : Tree ;


(*
    GetM2Integer64 - return the integer 64 bit type.
*)

PROCEDURE GetM2Integer64 () : Tree ;


(*
    GetM2Integer32 - return the integer 32 bit type.
*)

PROCEDURE GetM2Integer32 () : Tree ;


(*
    GetM2Integer16 - return the integer 16 bit type.
*)

PROCEDURE GetM2Integer16 () : Tree ;


(*
    GetM2Integer8 - return the integer 8 bit type.
*)

PROCEDURE GetM2Integer8 () : Tree ;


(*
    GetISOLocType - return the m2 loc word data type.
*)

PROCEDURE GetISOLocType () : Tree ;


(*
    GetISOByteType - return the m2 iso byte data type.
*)

PROCEDURE GetISOByteType () : Tree ;


(*
    GetISOWordType - return the m2 iso word data type.
*)

PROCEDURE GetISOWordType () : Tree ;


(*
    GetShortCardType - return the C short unsigned data type.
*)

PROCEDURE GetShortCardType () : Tree ;


(*
    GetM2ShortCardType - return the m2 short cardinal data type.
*)

PROCEDURE GetM2ShortCardType () : Tree ;


(*
    GetShortIntType - return the C short int data type.
*)

PROCEDURE GetShortIntType () : Tree ;


(*
    GetM2ShortIntType - return the m2 short integer data type.
*)

PROCEDURE GetM2ShortIntType () : Tree ;


(*
    GetM2LongCardType - return the m2 long cardinal data type.
*)

PROCEDURE GetM2LongCardType () : Tree ;


(*
    GetM2LongIntType - return the m2 long integer data type.
*)

PROCEDURE GetM2LongIntType () : Tree ;


(*
    GetM2LongRealType - return the m2 long real data type.
*)

PROCEDURE GetM2LongRealType () : Tree ;


(*
    GetM2RealType - return the m2 real data type.
*)

PROCEDURE GetM2RealType () : Tree ;


(*
    GetM2ShortRealType - return the m2 short real data type.
*)

PROCEDURE GetM2ShortRealType () : Tree ;


(*
    GetM2IntegerType - return the m2 integer data type.
*)

PROCEDURE GetM2IntegerType () : Tree ;


(*
    GetM2CharType - return the m2 char data type.
*)

PROCEDURE GetM2CharType () : Tree ;


(*
   GetCSizeTType - return a type representing, size_t on this system.
*)

PROCEDURE GetCSizeTType () : Tree ;


(*
   GetCSSizeTType - return a type representing, ssize_t on this system.
*)

PROCEDURE GetCSSizeTType () : Tree ;


(*
    BuildArrayStringConstructor - creates an array constructor for, arrayType,
                                  consisting of the character elements
                                  defined by, str, of, length, characters.
*)

PROCEDURE BuildArrayStringConstructor (location: location_t; arrayType: Tree; str: Tree; length: Tree) : Tree ;


(*
    RealToTree - convert a real number into a Tree.
*)

PROCEDURE RealToTree (name: ADDRESS) : Tree ;


(*
    BuildStartRecord - return a RECORD tree.
*)

PROCEDURE BuildStartRecord (location: location_t; name: ADDRESS) : Tree ;


(*
    BuildStartUnion - return a union tree.
*)

PROCEDURE BuildStartUnion (location: location_t; name: ADDRESS) : Tree ;



PROCEDURE BuildStartVarient (location: location_t; name: ADDRESS) : Tree ;



PROCEDURE BuildEndVarient (location: location_t; varientField: Tree; varientList: Tree; isPacked: BOOLEAN) : Tree ;



PROCEDURE BuildStartFieldVarient (location: location_t; name: ADDRESS) : Tree ;



PROCEDURE BuildEndFieldVarient (location: location_t; varientField: Tree; varientList: Tree; isPacked: BOOLEAN) : Tree ;



PROCEDURE BuildStartFieldRecord (location: location_t; name: ADDRESS; type: Tree) : Tree ;



PROCEDURE BuildFieldRecord (location: location_t; name: ADDRESS; type: Tree) : Tree ;


(*
    ChainOn - interface so that Modula-2 can also create chains of
              declarations.
*)

PROCEDURE ChainOn (t1: Tree; t2: Tree) : Tree ;


(*
    ChainOnParamValue - adds a list node {{name, str}, value} into the tree list.
*)

PROCEDURE ChainOnParamValue (list: Tree; name: Tree; str: Tree; value: Tree) : Tree ;


(*
   AddStringToTreeList - adds, string, to list.
*)

PROCEDURE AddStringToTreeList (list: Tree; string: Tree) : Tree ;


(*
    BuildEndRecord - a heavily pruned finish_struct from c-decl.c.
                     It sets the context for each field to, t,
                     propagates isPacked throughout the fields in
                     the structure.
*)

PROCEDURE BuildEndRecord (location: location_t; record: Tree; fieldlist: Tree; isPacked: BOOLEAN) : Tree ;


(*
    SetAlignment - sets the alignment of a, node, to, align.
                   It duplicates the, node, and sets the alignment
                   to prevent alignment effecting behaviour elsewhere.
*)

PROCEDURE SetAlignment (node: Tree; align: Tree) : Tree ;


(*
    SetDeclPacked - sets the packed bit in decl TREE, node.
                    It returns the node.
*)

PROCEDURE SetDeclPacked (node: Tree) : Tree ;


(*
    SetTypePacked - sets the packed bit in type TREE, node.
                    It returns the node.
*)

PROCEDURE SetTypePacked (node: Tree) : Tree ;


(*
    SetRecordFieldOffset - returns field after the byteOffset and bitOffset
                           has been applied to it.
*)

PROCEDURE SetRecordFieldOffset (field: Tree; byteOffset: Tree; bitOffset: Tree; fieldtype: Tree; nbits: Tree) : Tree ;


(*
    BuildPackedFieldRecord - builds a packed field record of,
                             name, and, fieldtype.
*)

PROCEDURE BuildPackedFieldRecord (location: location_t; name: ADDRESS; fieldtype: Tree) : Tree ;


(*
    BuildNumberOfArrayElements - returns the number of elements in an
                                 arrayType.
*)

PROCEDURE BuildNumberOfArrayElements (location: location_t; arrayType: Tree) : Tree ;


(*
    AddStatement - maps onto add_stmt.
*)

PROCEDURE AddStatement (location: location_t; t: Tree) ;


(*
    MarkFunctionReferenced - marks a function as referenced.
*)

PROCEDURE MarkFunctionReferenced (f: Tree) ;


(*
    GarbageCollect - force gcc to garbage collect.
*)

PROCEDURE GarbageCollect ;


(*
   BuildArrayIndexType - creates an integer index which accesses an array.
                         low and high are the min, max elements of the array.
*)

PROCEDURE BuildArrayIndexType (low: Tree; high: Tree) : Tree ;


(*
   GetArrayNoOfElements - returns the number of elements in, arraytype.
*)

PROCEDURE GetArrayNoOfElements (location: location_t; arraytype: Tree) : Tree ;


(*
   BuildEndArrayType - returns a type which is an array indexed by IndexType
                       and which has ElementType elements.
*)

PROCEDURE BuildEndArrayType (arraytype: Tree; elementtype: Tree; indextype: Tree; type: INTEGER) : Tree ;


(*
    PutArrayType -
*)

PROCEDURE PutArrayType (array: Tree; type: Tree) ;


(*
    BuildStartArrayType - creates an array with an indextype and elttype.  The front end
                          symbol, type, is also passed to allow the gccgm2 to return the
                          canonical edition of the array type even if the GCC elttype is
                          NULL_TREE.
*)

PROCEDURE BuildStartArrayType (index_type: Tree; elt_type: Tree; type: INTEGER) : Tree ;


(*
   IsAddress - return TRUE if the type is an ADDRESS.
*)

PROCEDURE IsAddress (type: Tree) : BOOLEAN ;


END m2type.
------------------------
New file: gcc/m2/gm2-gcc/dynamicstrings.h
------------------------
/* dynamicstrings.h provides a minimal interface to a string library.

Copyright (C) 2012-2022 Free Software Foundation, Inc.
Contributed by Gaius Mulley <gaius@glam.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/>.  */

#if !defined(dynamicstrings_h)

#define dynamicstrings_h
#if defined(dynamicstrings_c)
#define EXTERN
#else /* !dynamicstrings_c.  */
#define EXTERN extern
#endif /* !dynamicstrings_c.  */

typedef void *dynamicstrings_string;

EXTERN dynamicstrings_string DynamicStrings_Mark (dynamicstrings_string s);
EXTERN dynamicstrings_string
DynamicStrings_InitStringCharStar (dynamicstrings_string s);

#undef EXTERN
#endif  /* !dynamicstrings_h.  */
------------------------
New file: gcc/m2/gm2-gcc/m2statement.def
------------------------
(* m2statement.def definition module for m2statement.cc.

Copyright (C) 2011-2022 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 m2statement ;


FROM SYSTEM IMPORT ADDRESS ;
FROM m2tree IMPORT Tree ;
FROM m2linemap IMPORT location_t ;
FROM m2expr IMPORT BuildUnarySetFunction ;


(*
   DoJump - jump to the appropriate label depending whether
            result of the expression is TRUE or FALSE.
*)

PROCEDURE DoJump (location: location_t; exp: Tree; falselabel: ADDRESS; truelabel: ADDRESS) ;


(*
   BuildStartFunctionCode - generate function entry code.
*)

PROCEDURE BuildStartFunctionCode (location: location_t; fndecl: Tree; isexported: BOOLEAN; isinline: BOOLEAN) ;


(*
   BuildEndFunctionCode - generates the function epilogue.
*)

PROCEDURE BuildEndFunctionCode (location: location_t; fndecl: Tree; nested: BOOLEAN) ;


(*
   BuildReturnValueCode - generates the code associated with: RETURN( value )
*)

PROCEDURE BuildReturnValueCode (location: location_t; fndecl: Tree; value: Tree) ;


(*
   BuildPushFunctionContext - pushes the current function context.
                              Maps onto push_function_context in ../function.c
*)

PROCEDURE BuildPushFunctionContext ;


(*
   BuildPopFunctionContext - pops the current function context.
                             Maps onto pop_function_context in ../function.c
*)

PROCEDURE BuildPopFunctionContext ;


(*
   BuildAssignmentTree - builds the assignment of, des, and, expr.
                         It returns, des.
*)

PROCEDURE BuildAssignmentTree (location: location_t; des, expr: Tree) : Tree ;


(*
   BuildAssignmentStatement builds the assignment of, des, and, expr.
*)

PROCEDURE BuildAssignmentStatement (location: location_t; des, expr: Tree) ;


(*
   BuildGoto - builds a goto operation.
*)

PROCEDURE BuildGoto (location: location_t; name: ADDRESS) ;


(*
   DeclareLabel - create a label, name.
*)

PROCEDURE DeclareLabel (location: location_t; name: ADDRESS) ;


(*
   BuildIfThenDoEnd - returns a tree which will only execute
                      statement, s, if, condition, is true.
*)

PROCEDURE BuildIfThenDoEnd (condition: Tree; then_block: Tree) : Tree ;


(*
   BuildIfThenElseEnd - returns a tree which will execute
                        then_block or else_block depending upon,
                        condition.
*)

PROCEDURE BuildIfThenElseEnd (condition: Tree; then_block: Tree; else_block: Tree) : Tree ;


(*
   BuildParam - build a list of parameters, ready for a subsequent procedure call.
*)

PROCEDURE BuildParam (location: location_t; param: Tree) ;


(*
   BuildFunctionCallTree - creates a procedure function call from
                           a procedure and parameter list and the
                           return type, rettype.  No tree is returned
                           as the tree is held in the last_function
                           global variable.  It is expected the
                           BuildFunctValue is to be called after
                           a call to BuildFunctionCallTree.
*)

PROCEDURE BuildFunctionCallTree (location: location_t; procedure: Tree; rettype: Tree) ;


(*
   BuildProcedureCallTree - creates a procedure call from a procedure and
                            parameter list and the return type, rettype.
*)

PROCEDURE BuildProcedureCallTree (location: location_t; procedure: Tree; rettype: Tree) : Tree ;


(*
   BuildIndirectProcedureCallTree - creates a procedure call from a procedure and
                                    parameter list and the return type, rettype.
*)

PROCEDURE BuildIndirectProcedureCallTree (location: location_t; procedure: Tree; rettype: Tree) : Tree ;


(*
   BuildFunctValue - generates code for value := last_function(foobar);
*)

PROCEDURE BuildFunctValue (location: location_t; value: Tree) : Tree ;


(*
   BuildCall2 - builds a tree representing:  function(arg1, arg2).
*)

PROCEDURE BuildCall2 (location: location_t;
                      function, rettype, arg1, arg2: Tree) : Tree ;


(*
   BuildCall3 - builds a tree representing:  function(arg1, arg2, arg3).
*)

PROCEDURE BuildCall3 (location: location_t;
                      function, rettype, arg1, arg2, arg3: Tree) : Tree ;


(*
   SetLastFunction - set the last_function to, t.
*)

PROCEDURE SetLastFunction (t: Tree) ;


(*
   GetLastFunction - returns, last_function.
*)

PROCEDURE GetLastFunction () : Tree ;


(*
   GetParamTree - return parameter, i.
*)

PROCEDURE GetParamTree (call: Tree; i: CARDINAL) : Tree ;


(*
   BuildTryFinally - returns a TRY_FINALL_EXPR with the call and cleanups
                     attached.
*)

PROCEDURE BuildTryFinally (location: location_t; call: Tree; cleanups: Tree) : Tree ;


(*
   BuildCleanUp - return a CLEANUP_POINT_EXPR which will clobber, param.
*)

PROCEDURE BuildCleanUp (param: Tree) : Tree ;


(*
    BuildAsm - generates an inline assembler instruction.
*)

PROCEDURE BuildAsm (location: location_t; instr: Tree;
                    isVolatile: BOOLEAN; isSimple: BOOLEAN;
                    inputs: Tree; outputs: Tree; trash: Tree; labels: Tree) ;


(*
    BuildUnaryForeachWordDo - provides the large set operators.
                              Each word (or less) of the set can be
                              calculated by unop.
                              This procedure runs along each word
                              of the large set invoking the unop.
*)

PROCEDURE BuildUnaryForeachWordDo (location: location_t; type: Tree; op1: Tree; op2: Tree;
                                   unop: BuildUnarySetFunction;
                                   is_op1lvalue, is_op2lvalue, is_op1const, is_op2const: BOOLEAN) ;


(*
    BuildExcludeVarConst - builds the EXCL(op1, 1<<op2) operation for a small sets. Large
                           sets call this routine to exclude the bit in the particular word.
                           op2 is a constant.
*)

PROCEDURE BuildExcludeVarConst (location: location_t; type: Tree; op1: Tree; op2: Tree; is_lvalue: BOOLEAN; fieldno: INTEGER) ;


(*
    BuildExcludeVarVar - builds the EXCL(varset, 1<<varel) operation for a small and large sets.
                         varel is a variable.
*)

PROCEDURE BuildExcludeVarVar (location: location_t; type: Tree; varset: Tree; varel: Tree; is_lvalue: BOOLEAN; low: Tree) ;


(*
    BuildIncludeVarConst - builds the INCL(op1, 1<<op2) operation for a small sets. Large
                           sets call this routine to include the bit in the particular word.
                           op2 is a constant.
*)

PROCEDURE BuildIncludeVarConst (location: location_t; type: Tree; op1: Tree; op2: Tree; is_lvalue: BOOLEAN; fieldno: INTEGER) ;


(*
    BuildIncludeVarVar - builds the INCL(varset, 1<<varel) operation for a small and large sets.
                         op2 is a variable.
*)

PROCEDURE BuildIncludeVarVar (location: location_t; type: Tree; varset: Tree; varel: Tree; is_lvalue: BOOLEAN; low: Tree) ;


(*
    BuildStart - creates a module initialization function. We make
                 this function public if it is not an inner module.
                 The linker will create a call list for all linked
                 modules which determines the initialization
                 sequence for all modules.
*)

PROCEDURE BuildStart (location: location_t; name: ADDRESS; inner_module: BOOLEAN) : Tree ;


(*
    BuildEnd - complete the initialisation function for this module.
*)

PROCEDURE BuildEnd (location: location_t; fndecl: Tree; nested: BOOLEAN) ;


(*
    BuildCallInner - call the inner module function.  It has no parameters and no return value.
*)

PROCEDURE BuildCallInner (location: location_t; fndecl: Tree) ;


(*
    BuildStartMainModule - expands all the global variables ready for the main module.
*)

PROCEDURE BuildStartMainModule ;


(*
    BuildEndMainModule - tidies up the end of the main module. It moves
                         back to global scope.
*)

PROCEDURE BuildEndMainModule ;


(*
   SetBeginLocation - sets the begin location for the function to obtain good debugging info.
*)

PROCEDURE SetBeginLocation (location: location_t) ;


(*
   SetEndLocation - sets the end location for the function to obtain good debugging info.
*)

PROCEDURE SetEndLocation (location: location_t) ;


END m2statement.
------------------------
New file: gcc/m2/gm2-gcc/m2expr.def
------------------------
(* m2expr.def definition module for m2expr.cc.

Copyright (C) 2011-2022 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 FOR "C" m2expr ;

FROM SYSTEM IMPORT ADDRESS ;
FROM m2tree IMPORT Tree ;
FROM m2linemap IMPORT location_t ;


TYPE
   BuildBinCheckProcedure   = PROCEDURE (location_t, Tree, Tree, Tree, Tree, Tree) : Tree ;
   BuildBinProcedure        = PROCEDURE (location_t, Tree, Tree, BOOLEAN) : Tree ;
   BuildUnaryProcedure      = PROCEDURE (location_t, Tree, BOOLEAN) : Tree ;
   BuildUnaryCheckProcedure = PROCEDURE (location_t, Tree, Tree, Tree, Tree) : Tree ;
   BuildExprProcedure       = PROCEDURE (location_t, Tree, Tree) : Tree ;
   BuildSetProcedure        = PROCEDURE (location_t, Tree, Tree, Tree, Tree, BOOLEAN) ;
   BuildUnarySetProcedure   = PROCEDURE (location_t, Tree, BOOLEAN) ;
   BuildUnarySetFunction    = PROCEDURE (location_t, Tree, BOOLEAN) : Tree ;


(*
    init - initialise this module.
*)

PROCEDURE init (location: location_t) ;


(*
   CompareTrees - returns -1 if e1 < e2, 0 if e1 == e2, and 1 if e1 > e2.
*)

PROCEDURE CompareTrees (e1: Tree; e2: Tree) : INTEGER ;


PROCEDURE GetPointerOne (location: location_t) : Tree ;


PROCEDURE GetPointerZero (location: location_t) : Tree ;


PROCEDURE GetWordOne (location: location_t) : Tree ;


PROCEDURE GetWordZero (location: location_t) : Tree ;


PROCEDURE GetIntegerOne (location: location_t) : Tree ;


PROCEDURE GetIntegerZero (location: location_t) : Tree ;


PROCEDURE GetCardinalOne (location: location_t) : Tree ;


PROCEDURE GetCardinalZero (location: location_t) : Tree ;


PROCEDURE GetSizeOfInBits (type: Tree) : Tree ;


PROCEDURE GetSizeOf (location: location_t; type: Tree) : Tree ;


(*
    BuildLogicalRotate - builds the ISO Modula-2 ROTATE operator
                         for a fundamental data type.
*)

PROCEDURE BuildLogicalRotate (location: location_t; op1: Tree; op2: Tree; op3: Tree; nBits: Tree; needconvert: BOOLEAN) ;


(*
    BuildLRRn - builds and returns tree (op1 rotate right by op2 bits)
                it rotates a set of size, nBits.
*)

PROCEDURE BuildLRRn (location: location_t; op1: Tree; op2: Tree; nBits: Tree; needconvert: BOOLEAN) : Tree ;


(*
    BuildLRLn - builds and returns tree (op1 rotate left by op2 bits)
                it rotates a set of size, nBits.
*)

PROCEDURE BuildLRLn (location: location_t; op1: Tree; op2: Tree; nBits: Tree; needconvert: BOOLEAN) : Tree ;



PROCEDURE BuildMask (location: location_t; nBits: Tree; needconvert: BOOLEAN) : Tree ;


(*
    BuildMult - builds a multiplication tree.
*)

PROCEDURE BuildMult (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ;


(*
    BuildMultCheck - builds a multiplication tree after checking for overflow.
*)

PROCEDURE BuildMultCheck (location: location_t; op1, op2, lowest, min, max: Tree) : Tree ;


(*
    BuildLRR - builds and returns tree (op1 rotate right by op2 bits)
*)

PROCEDURE BuildLRR (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ;


(*
    BuildLRL - builds and returns tree (op1 rotate left by op2 bits)
*)

PROCEDURE BuildLRL (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ;


(*
    BuildLogicalShift - builds the ISO Modula-2 SHIFT operator
                        for a fundamental data type.
*)

PROCEDURE BuildLogicalShift (location: location_t; op1: Tree; op2: Tree; op3: Tree; nBits: Tree; needconvert: BOOLEAN) ;


(*
    BuildLSR - builds and returns tree (op1 >> op2)
*)

PROCEDURE BuildLSR (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ;


(*
    BuildLSL - builds and returns tree (op1 << op2)
*)

PROCEDURE BuildLSL (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ;


(*
   BuildDivM2 - build and return ((op2 < 0) : (op1 divtrunc op2) ? (op1 divfloor op2))
                when -fiso, -fpim4 or -fpositive-mod-floor-div is present else
                return op1 div trunc op2
*)

PROCEDURE BuildDivM2 (location: location_t; op1, op2: Tree; needsconvert: BOOLEAN) : Tree ;


(*
   BuildDivM2Check - build and return ((op2 < 0) : (op1 divtrunc op2) ? (op1 divfloor op2))
                     when -fiso, -fpim4 or -fpositive-mod-floor-div is present else
                     return op1 div trunc op2.  Use the checking div equivalents.
*)

PROCEDURE BuildDivM2Check (location: location_t; op1, op2, lowest, min, max: Tree) : Tree ;


(*
   BuildModM2 - build and return ((op2 < 0) : (op1 divtrunc op2) ? (op1 divfloor op2))
                when -fiso, -fpim4 or -fpositive-mod-floor-div is present else
                return op1 div trunc op2
*)

PROCEDURE BuildModM2 (location: location_t; op1, op2: Tree; needsconvert: BOOLEAN) : Tree ;


(*
   BuildModM2Check - if iso or pim4 then build and return ((op2 < 0) : (op1
                     modceil op2) ?  (op1 modfloor op2)) otherwise use modtrunc.
                     Use the checking mod equivalents.
                     build and return ((op2 < 0) : (op1 divtrunc op2) ? (op1 divfloor op2))
                     when -fiso, -fpim4 or -fpositive-mod-floor-div is present else
                     return op1 div trunc op2.  Use the checking div equivalents.
*)

PROCEDURE BuildModM2Check (location: location_t; op1, op2, lowest, min, max: Tree) : Tree ;


(*
    BuildModFloor - builds a modulus tree.
*)

PROCEDURE BuildModFloor (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ;


(*
    BuildDivCeil - builds a division tree.
*)

PROCEDURE BuildDivCeil (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ;


(*
    BuildModCeil - builds a modulus tree.
*)

PROCEDURE BuildModCeil (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ;


(*
    BuildDivFloor - builds a division tree.
*)

PROCEDURE BuildDivFloor (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ;


(*
    BuildModTrunc - builds a modulus tree.
*)

PROCEDURE BuildModTrunc (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ;


(*
    BuildDivTrunc - builds a division tree.
*)

PROCEDURE BuildDivTrunc (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ;


(*
    BuildDivTruncCheck - builds a division tree after checking for overflow.
*)

PROCEDURE BuildDivTruncCheck (location: location_t; op1, op2, lowest, min, max: Tree) : Tree ;


(*
   BuildRDiv - builds a division tree (this should only be used for REAL and COMPLEX
               types and NEVER for integer based types).
*)

PROCEDURE BuildRDiv (location: location_t; op1, op2: Tree; needconvert: BOOLEAN) : Tree ;


(*
    BuildSubCheck - builds a subtraction tree after checking for overflow.
*)

PROCEDURE BuildSubCheck (location: location_t; op1, op2, lowest, min, max: Tree) : Tree ;


(*
    BuildAddCheck - builds an addition tree after checking for overflow.
*)

PROCEDURE BuildAddCheck (location: location_t; op1, op2, lowest, min, max: Tree) : Tree ;


(*
    BuildSub - builds a subtraction tree.
*)

PROCEDURE BuildSub (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ;


(*
    BuildAdd - builds an addition tree.
*)

PROCEDURE BuildAdd (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ;


(*
    FoldAndStrip - return expression, t, after it has been folded (if possible).
*)

PROCEDURE FoldAndStrip (t: Tree) : Tree ;


(*
    StringLength - returns an unsigned int which is the length
                   of, string.
*)

PROCEDURE StringLength (string: Tree) : CARDINAL ;


(*
   TreeOverflow - returns TRUE if the contant expression, t, has
                  caused an overflow. No error message or warning
                  is emitted and no modification is made to, t.
*)

PROCEDURE TreeOverflow (t: Tree) : BOOLEAN ;


(*
    RemoveOverflow - if tree, t, is a constant expression it removes
                     any overflow flag and returns, t.
*)

PROCEDURE RemoveOverflow (t: Tree) : Tree ;


(*
    BuildCoerce - returns a tree containing the expression, expr, after
                  it has been coersed to, type.
*)

PROCEDURE BuildCoerce (location: location_t; des: Tree; type: Tree; expr: Tree) : Tree ;


(*
    BuildTrunc - returns an integer expression from a REAL or LONGREAL op1.
*)

PROCEDURE BuildTrunc (op1: Tree) : Tree ;


(*
    BuildNegate - builds a negate expression and returns the tree.
*)

PROCEDURE BuildNegate (location: location_t; op1: Tree; needconvert: BOOLEAN) : Tree ;


(*
    BuildNegateCheck - builds a negate expression and returns the tree.
*)

PROCEDURE BuildNegateCheck (location: location_t; arg, lowest, min, max: Tree) : Tree ;


(*
    BuildSetNegate - builds a set negate expression and returns the tree.
*)

PROCEDURE BuildSetNegate (location: location_t; op1: Tree; needconvert: BOOLEAN) : Tree ;


(*
    BuildTBitSize - returns the minimum number of bits to represent, type.
*)

PROCEDURE BuildTBitSize (location: location_t; type: Tree) : Tree ;


(*
    BuildSize - builds a SIZE function expression and returns the tree.
*)

PROCEDURE BuildSize (location: location_t; op1: Tree; needconvert: BOOLEAN) : Tree ;


(*
    BuildAddr - builds an expression which calculates the address of
                op1 and returns the tree.
*)

PROCEDURE BuildAddr (location: location_t; op1: Tree; needconvert: BOOLEAN) : Tree ;


(*
    BuildOffset1 - builds an expression containing the number of bytes the field
                   is offset from the start of the record structure.
                   This function is the same as the above, except that it
                   derives the record from the field and then calls BuildOffset.
                   The expression is returned.
*)

PROCEDURE BuildOffset1 (location: location_t; field: Tree; needconvert: BOOLEAN) : Tree ;


(*
    BuildOffset - builds an expression containing the number of bytes the field
                  is offset from the start of the record structure.
                  The expression is returned.
*)

PROCEDURE BuildOffset (location: location_t; record: Tree; field: Tree; needconvert: BOOLEAN) : Tree ;


(*
    BuildLogicalOrAddress - build a logical or expressions and return the tree.
*)

PROCEDURE BuildLogicalOrAddress (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ;


(*
    BuildLogicalOr - build a logical or expressions and return the tree.
*)

PROCEDURE BuildLogicalOr (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ;


(*
    BuildLogicalAnd - build a logical and expression and return the tree.
*)

PROCEDURE BuildLogicalAnd (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ;



PROCEDURE BuildSymmetricDifference (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ;


(*
    BuildLogicalDifference - build a logical difference expression and
                             return the tree.
                             (op1 and (not op2))
*)

PROCEDURE BuildLogicalDifference (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ;


(*
    BuildLessThan - return a tree which computes <
*)

PROCEDURE BuildLessThan (location: location_t; op1: Tree; op2: Tree) : Tree ;


(*
    BuildGreaterThan - return a tree which computes >
*)

PROCEDURE BuildGreaterThan (location: location_t; op1: Tree; op2: Tree) : Tree ;


(*
    BuildLessThanOrEqual - return a tree which computes <
*)

PROCEDURE BuildLessThanOrEqual (location: location_t; op1: Tree; op2: Tree) : Tree ;


(*
    BuildGreaterThanOrEqual - return a tree which computes >=
*)

PROCEDURE BuildGreaterThanOrEqual (location: location_t; op1: Tree; op2: Tree) : Tree ;


(*
    BuildEqualTo - return a tree which computes =
*)

PROCEDURE BuildEqualTo (location: location_t; op1: Tree; op2: Tree) : Tree ;



PROCEDURE BuildNotEqualTo (location: location_t; op1: Tree; op2: Tree) : Tree ;


(*
    BuildIsSuperset - return a tree which computes:  op1 & op2 == op2
*)

PROCEDURE BuildIsSuperset (location: location_t; op1: Tree; op2: Tree) : Tree ;


(*
    BuildIsNotSuperset - return a tree which computes: op1 & op2 != op2
*)

PROCEDURE BuildIsNotSuperset (location: location_t; op1: Tree; op2: Tree) : Tree ;


(*
    BuildIsSubset - return a tree which computes:  op1 & op2 == op1
*)

PROCEDURE BuildIsSubset (location: location_t; op1: Tree; op2: Tree) : Tree ;


(*
    BuildIsNotSubset - return a tree which computes: op1 & op2 != op1
*)

PROCEDURE BuildIsNotSubset (location: location_t; op1: Tree; op2: Tree) : Tree ;


(*
    BuildIfConstInVar - generates: if constel in varset then goto label.
*)

PROCEDURE BuildIfConstInVar (location: location_t; type: Tree; varset: Tree; constel: Tree; is_lvalue: BOOLEAN; fieldno: INTEGER; label: ADDRESS) ;



PROCEDURE BuildIfNotConstInVar (location: location_t; type: Tree; varset: Tree; constel: Tree; is_lvalue: BOOLEAN; fieldno: INTEGER; label: ADDRESS) ;


(*
    BuildIfVarInVar - generates: if varel in varset then goto label
*)

PROCEDURE BuildIfVarInVar (location: location_t; type: Tree; varset: Tree; varel: Tree; is_lvalue: BOOLEAN; low: Tree; high: Tree; label: ADDRESS) ;


(*
    BuildIfNotVarInVar - generates: if not (varel in varset) then goto label
*)

PROCEDURE BuildIfNotVarInVar (location: location_t; type: Tree; varset: Tree; varel: Tree; is_lvalue: BOOLEAN; low: Tree; high: Tree; label: ADDRESS) ;


(*
    BuildForeachWordInSetDoIfExpr - foreach word in set, type, compute the expression, expr, and if true
                                    goto label.
*)

PROCEDURE BuildForeachWordInSetDoIfExpr (location: location_t;
                                         type, op1, op2: Tree;
				         is_op1lvalue, is_op2lvalue,
				         is_op1const, isop2const: BOOLEAN;
                                         expr: BuildExprProcedure; label: ADDRESS) ;


(*
    BuildIfInRangeGoto - if var is in the range low..high then goto label
*)

PROCEDURE BuildIfInRangeGoto (location: location_t; var: Tree; low: Tree; high: Tree; label: ADDRESS) ;


(*
    BuildIfNotInRangeGoto - if var is not in the range low..high then goto label
*)

PROCEDURE BuildIfNotInRangeGoto (location: location_t; var: Tree; low: Tree; high: Tree; label: ADDRESS) ;


(*
    BuildArray - returns a tree which accesses array[index]
                 given, lowIndice.
*)

PROCEDURE BuildArray (location: location_t; type: Tree; array: Tree; index: Tree; lowIndice: Tree) : Tree ;


(*
   BuildComponentRef - build a component reference tree which accesses record.field.
                       If field does not belong to record it calls
                       BuildComponentRef on the penultimate field.
*)

PROCEDURE BuildComponentRef (location: location_t; record: Tree; field: Tree) : Tree ;


(*
    BuildIndirect - build: ( *target) given that the object to be copied is of, type.
*)

PROCEDURE BuildIndirect (location: location_t; target: Tree; type: Tree) : Tree ;


(*
    IsTrue - returns TRUE if, t, is known to be TRUE.
*)

PROCEDURE IsTrue (t: Tree) : BOOLEAN ;


(*
    IsFalse - returns FALSE if, t, is known to be FALSE.
*)

PROCEDURE IsFalse (t: Tree) : BOOLEAN ;


(*
    AreConstantsEqual - maps onto tree.c (tree_int_cst_equal). It returns
                        TRUE if the value of e1 is the same as e2.
*)

PROCEDURE AreConstantsEqual (e1: Tree; e2: Tree) : BOOLEAN ;


(*
    AreRealOrComplexConstantsEqual - returns TRUE if constants,
                                     e1 and e2 are equal according
                                     to IEEE rules.  This does not
                                     perform bit equivalence for
                                     example IEEE states that
                                     -0 == 0 and NaN != NaN.
*)

PROCEDURE AreRealOrComplexConstantsEqual (e1: Tree; e2: Tree) : BOOLEAN ;


(*
    DetermineSign - returns -1 if e<0
                             0 if e==0
                             1 if e>0

                    an unsigned constant will never return -1
*)

PROCEDURE DetermineSign (e: Tree) : INTEGER ;


(*
    BuildCap - builds the Modula-2 function CAP(t) and returns
               the result in a gcc Tree.
*)

PROCEDURE BuildCap (location: location_t; t: Tree) : Tree ;


(*
    BuildAbs - builds the Modula-2 function ABS(t) and returns
               the result in a gcc Tree.
*)

PROCEDURE BuildAbs (location: location_t; t: Tree) : Tree ;


(*
    BuildRe - builds an expression for the function RE.
*)

PROCEDURE BuildRe (op1: Tree) : Tree ;


(*
    BuildIm - builds an expression for the function IM.
*)

PROCEDURE BuildIm (op1: Tree) : Tree ;


(*
    BuildCmplx - builds an expression for the function CMPLX.
*)

PROCEDURE BuildCmplx (location: location_t; type: Tree; real: Tree; imag: Tree) : Tree ;


(*
    BuildBinaryForeachWordDo - provides the large set operators. Each word
                               (or less) of the set can be calculated by binop.
                               This procedure runs along each word of the
                               large set invoking the binop.
*)

PROCEDURE BuildBinaryForeachWordDo (location: location_t;
                                    type, op1, op2, op3: Tree;
                                    binop: BuildBinProcedure;
                                    is_op1lvalue,
                                    is_op2lvalue,
                                    is_op3lvalue,
                                    is_op1_const,
                                    is_op2_const,
                                    is_op3_const: BOOLEAN) ;

(*
   BuildBinarySetDo - if the size of the set is <= TSIZE(WORD) then
                         op1 := binop(op2, op3)
                      else
                         call m2rtsprocedure(op1, op2, op3)
*)

PROCEDURE BuildBinarySetDo (location: location_t;
                            settype, op1, op2, op3: Tree;
                            binop: BuildSetProcedure;
                            is_op1lvalue, is_op2lvalue, is_op3lvalue: BOOLEAN;
                            nBits, unbounded: Tree;
                            varproc, leftproc, rightproc: Tree) ;

(*
   ConstantExpressionWarning - issue a warning if the constant has overflowed.
*)

PROCEDURE ConstantExpressionWarning (value: Tree) ;


(*
   BuildAddAddress - returns an expression op1+op2 where op1 is a pointer type
                     and op2 is not a pointer type.
*)

PROCEDURE BuildAddAddress (location: location_t; op1, op2: Tree) : Tree ;


END m2expr.
------------------------
New file: gcc/m2/gm2-gcc/m2convert.def
------------------------
(* m2convert.def definition module for m2convert.cc.

Copyright (C) 2011-2022 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 m2convert ;

FROM m2tree IMPORT Tree ;
FROM m2linemap IMPORT location_t ;


(*
   ToWord - converts an expression (Integer or Ordinal type) into
            a WORD.
*)

PROCEDURE ToWord (location: location_t; expr: Tree) : Tree ;


(*
   ToCardinal - convert an expression, expr, to a CARDINAL.
*)

PROCEDURE ToCardinal (location: location_t; expr: Tree) : Tree ;


(*
   ToInteger - convert an expression, expr, to an INTEGER.
*)

PROCEDURE ToInteger (location: location_t; expr: Tree) : Tree ;


(*
   ToBitset - convert an expression, expr, to a BITSET.
*)

PROCEDURE ToBitset (location: location_t; expr: Tree) : Tree ;


(*
   ConvertToPtr - convert an expression to a void *.
*)

PROCEDURE ConvertToPtr (p: Tree) : Tree ;


(*
    BuildConvert - build and return tree VAL(type, value)
                   checkOverflow determines whether we
                   should suppress overflow checking.
*)

PROCEDURE BuildConvert (location: location_t; type: Tree; value: Tree; checkOverflow: BOOLEAN) : Tree ;


(*
   ConvertConstantAndCheck - in Modula-2 sementics: return( VAL(type, expr) )
                             Only to be used for a constant expr,
                             overflow checking is performed.
*)

PROCEDURE ConvertConstantAndCheck (location: location_t; type: Tree; expr: Tree) : Tree ;


(*
   ConvertString - converts string, expr, into a string of type, type.
*)

PROCEDURE ConvertString (type, expr: Tree) : Tree ;


(*
   GenericToType - converts, expr, into, type, providing that expr is
                   a generic system type (byte, word etc).  Otherwise
                   expr is returned unaltered.
*)

PROCEDURE GenericToType (location: location_t; type, expr: Tree) : Tree ;


END m2convert.
------------------------
New file: gcc/m2/gm2-gcc/m2decl.def
------------------------
(* m2decl.def definition module for m2decl.cc.

Copyright (C) 2011-2022 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 m2decl ;

FROM SYSTEM IMPORT ADDRESS ;
FROM m2tree IMPORT Tree ;
FROM m2linemap IMPORT location_t ;


(*
    GetBitsPerBitset - returns the number of bits in a BITSET.
*)

PROCEDURE GetBitsPerBitset () : INTEGER ;


(*
    GetBitsPerInt - returns the number of bits in a INTEGER.
*)

PROCEDURE GetBitsPerInt () : INTEGER ;


(*
    GetBitsPerUnit - returns the number of bits in a UNIT.
*)

PROCEDURE GetBitsPerUnit () : INTEGER ;


(*
    GetBitsPerWord - returns the number of bits in a WORD.
*)

PROCEDURE GetBitsPerWord () : INTEGER ;


(*
    BuildIntegerConstant - return a tree containing the integer value.
*)

PROCEDURE BuildIntegerConstant (value: INTEGER) : Tree ;


(*
    BuildStringConstantType - builds a string constant with a type.
*)

PROCEDURE BuildStringConstantType (length: INTEGER; string: ADDRESS; type: Tree) : Tree ;


(*
    DeclareKnownVariable - declares a variable in scope,
                           funcscope. Note that the global variable,
                           current_function_decl, is altered if
                           isglobal is TRUE.
*)

PROCEDURE DeclareKnownVariable (location: location_t; name: ADDRESS; type: Tree;
                                exported, imported, istemporary, isglobal: BOOLEAN;
                                scope: Tree) : Tree ;


(*
    DeclareKnownConstant - given a constant, value, of, type, create a constant in the GCC
                           symbol table. Note that the name of the constant is not used
                           as _all_ constants are declared in the global scope. The front end
                           deals with scoping rules - here we declare all constants with no names
                           in the global scope. This allows M2SubExp and constant folding routines
                           the liberty of operating with quadruples which all assume constants can
                           always be referenced.
*)

PROCEDURE DeclareKnownConstant (location: location_t; type: Tree; value: Tree) : Tree ;


(*
    BuildParameterDeclaration - creates and returns one parameter from, name, and, type.
                                It appends this parameter to the internal param_type_list.
                                If name is nul then we assume we are creating a function
                                type declaration and we ignore names.
*)

PROCEDURE BuildParameterDeclaration (location: location_t; name: ADDRESS; type: Tree;
                                     isreference: BOOLEAN) : Tree ;


(*
    BuildStartFunctionDeclaration - initializes global variables ready
                                    for building a function.
*)

PROCEDURE BuildStartFunctionDeclaration (uses_varargs: BOOLEAN) ;


(*
    BuildEndFunctionDeclaration - build a function which will return a value of returntype.
                                  The arguments have been created by BuildParameterDeclaration.
*)

PROCEDURE BuildEndFunctionDeclaration (location_begin, location_end: location_t;
                                       name: ADDRESS; returntype: Tree;
                                       isexternal, isnested, ispublic: BOOLEAN) : Tree ;


(*
    RememberVariables -
*)

PROCEDURE RememberVariables (l: Tree) ;


(*
    DetermineSizeOfConstant - given, str, and, base, fill in
                              needsLong and needsUnsigned appropriately.
*)

PROCEDURE DetermineSizeOfConstant (str: ADDRESS; base: CARDINAL;
                                   VAR needsLong, needsUnsigned: BOOLEAN) ;


(*
    BuildConstLiteralNumber - returns a GCC TREE built from the string, str.
                              It assumes that, str, represents a legal
                              number in Modula-2. It always returns a
                              positive value.
*)

PROCEDURE BuildConstLiteralNumber (str: ADDRESS; base: CARDINAL) : Tree ;


(*
    BuildStringConstant - creates a string constant given a, string,
                          and, length.
*)

PROCEDURE BuildStringConstant (location: location_t; string: ADDRESS; length: INTEGER) : Tree ;


(*
    BuildCStringConstant - creates a string constant given a, string,
                           and, length.
*)

PROCEDURE BuildCStringConstant (string: ADDRESS; length: INTEGER) : Tree ;



PROCEDURE GetDeclContext (t: Tree) : Tree ;


END m2decl.
------------------------
New file: gcc/m2/gm2-gcc/m2tree.def
------------------------
(* m2tree.def definition module for m2tree.cc.

Copyright (C) 2011-2022 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 m2tree ;

FROM SYSTEM IMPORT ADDRESS ;

TYPE
   Tree = ADDRESS ;


PROCEDURE IsAConstant (t: Tree) : BOOLEAN ;
PROCEDURE IsOrdinal (type: Tree) : BOOLEAN ;
PROCEDURE IsTreeOverflow (value: Tree) : BOOLEAN ;
PROCEDURE skip_const_decl (exp: Tree) : Tree ;
PROCEDURE skip_type_decl (type: Tree) : Tree ;
PROCEDURE is_type (type: Tree) : BOOLEAN ;
PROCEDURE is_array (array: Tree) : BOOLEAN ;
PROCEDURE is_var (var: Tree) : BOOLEAN ;
PROCEDURE debug_tree (t: Tree) ;


END m2tree.
------------------------
New file: gcc/m2/gm2-gcc/m2color.def
------------------------
(* m2color.def interface to gcc colorization.

Copyright (C) 2019-2022 Free Software Foundation, Inc.
Contributed by Gaius Mulley <gaius@glam.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 m2color ;

FROM SYSTEM IMPORT ADDRESS ;


(* colorize_start - returns a C string containing the color escape sequences
   mapped onto, name.  See diagnostic-color.c for the definitive
   list of GCC colors.  The name list includes: error, warning,
   note, range1, range2, quote, locus, fixit-insert, fixit-delete,
   diff-filename, diff-hunk, diff-delete, diff-insert, type-diff.  *)

PROCEDURE colorize_start (show_color: BOOLEAN;
                          name: ARRAY OF CHAR; name_len: CARDINAL) : ADDRESS ;

(* colorize_stop - return a C string containing the escape sequences to
   stop text colorization.  *)

PROCEDURE colorize_stop (show_color: BOOLEAN) : ADDRESS ;


(* open_quote - return a C string containing the open quote character which
   might be a UTF-8 character if on a UTF-8 supporting host.  *)

PROCEDURE open_quote () : ADDRESS ;


(* close_quote - return a C string containing the close quote character which
   might be a UTF-8 character if on a UTF-8 supporting host.  *)

PROCEDURE close_quote () : ADDRESS ;


END m2color.
------------------------
New file: gcc/m2/gm2-gcc/m2block.def
------------------------
(* m2block.def definition module for m2block.cc.

Copyright (C) 2011-2022 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 m2block ;


FROM m2tree IMPORT Tree ;
FROM m2linemap IMPORT location_t ;
FROM SYSTEM IMPORT ADDRESS ;


(*
    init - initialise the data structures in this module.
*)

PROCEDURE init ;


(*
    toplevel - return TRUE if we are in the global scope.
*)

PROCEDURE toplevel () : BOOLEAN ;


(*
    global_constant - t is a constant, we keep a chain of all constants
                      in the global binding level.
*)

PROCEDURE global_constant (t: Tree) : Tree ;


(*
    RememberInitModuleFunction - records tree, t, in the global binding level.
                                 So that it will not be garbage collected.
                                 In theory the inner modules could be placed
                                 inside the current_binding_level I suspect.
*)

PROCEDURE RememberInitModuleFunction (t: Tree) : Tree ;


(*
    DumpGlobalConstants - displays all global constants and checks none are
                          poisoned.
*)

PROCEDURE DumpGlobalConstants () : Tree ;


(*
    RememberConstant - adds a tree, t, onto the list of constants to be marked
                       whenever the ggc re-marks all used storage.  Constants
                       live throughout the whole compilation - and they
                       can be used by many different functions if necessary.
*)

PROCEDURE RememberConstant (t: Tree) : Tree ;


(*
    RememberType - remember the type, t, in the ggc marked list.
*)

PROCEDURE RememberType (t: Tree) : Tree ;


(*
    pushDecl - pushes a declaration onto the current binding level.
*)

PROCEDURE pushDecl (decl: Tree) : Tree ;


(*
    popGlobalScope - pops the current binding level, it expects this binding level
                     to be the global binding level.
*)

PROCEDURE popGlobalScope ;


(*
    pushGlobalScope - push the global scope onto the binding level stack.
                      There can only ever be one instance of the global binding
                      level on the stack.
*)

PROCEDURE pushGlobalScope ;


(*
    popFunctionScope - pops a binding level, returning the function associated with the
                       binding level.
*)

PROCEDURE popFunctionScope () : Tree ;


(*
    pushFunctionScope - push a binding level.
*)

PROCEDURE pushFunctionScope (fndecl: Tree) ;


(*
   finishFunctionCode - adds cur_stmt_list to fndecl.  The current binding level
                        is then able to be destroyed by a call to popFunctionScope.
                        The cur_stmt_list is appended to the STATEMENT_LIST.
*)

PROCEDURE finishFunctionCode (fndecl: Tree) ;


(*
   finishFunctionDecl - removes declarations from the current binding level and places
                        them inside fndecl.  The current binding level is then able to
                        be destroyed by a call to popFunctionScope.

                        The extra tree nodes associated with fndecl will be created
                        such as BIND_EXPR, BLOCK and the initial STATEMENT_LIST
                        containing the DECL_EXPR is also created.
*)

PROCEDURE finishFunctionDecl (location: location_t; fndecl: Tree) ;


(*
    getLabel - return the label, name, or create a label, name
               in the current scope.
*)

PROCEDURE getLabel (location: location_t; name: ADDRESS) : Tree ;


(*
   GetErrorNode - returns the gcc error_mark_node.
*)

PROCEDURE GetErrorNode () : Tree ;


(*
   includeDecl - pushes a declaration onto the current binding level providing
                 it is not already present.
*)

PROCEDURE includeDecl (decl: Tree) ;


(*
   GetGlobals - returns a list of global variables, functions, constants.
*)

PROCEDURE GetGlobals () : Tree ;


(*
   GetGlobalContext - returns the global context tree.
*)

PROCEDURE GetGlobalContext () : Tree ;


(*
   begin_statement_list - starts a tree statement.  It pushes the
                          statement list and returns the list node.
*)

PROCEDURE begin_statement_list () : Tree ;


(*
   push_statement_list - pushes the statement list, t, onto the
                         current binding level.
*)

PROCEDURE push_statement_list (t: Tree) : Tree ;


(*
   pop_statement_list - pops and returns a statement list from the
                        current binding level.
*)

PROCEDURE pop_statement_list () : Tree ;


(*
   addStmtNote - remember this location represents the start of a Modula-2
                 statement.  It is flushed if another different location is
                 generated or another tree is given to add_stmt.
*)

PROCEDURE addStmtNote (location: location_t) ;


(*
   removeStmtNote - removes any pending stmt note.
*)

PROCEDURE removeStmtNote ;


END m2block.
------------------------
New file: gcc/m2/gm2-gcc/m2top.def
------------------------
(* m2top.def definition module for m2top.cc.

Copyright (C) 2011-2022 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 m2top ;


(*
   SetFlagUnitAtATime - sets GCC flag_unit_at_a_time to b.
*)

PROCEDURE SetFlagUnitAtATime (b: BOOLEAN) ;


(*
   StartGlobalContext - initializes a dummy function for the global scope.
*)

PROCEDURE StartGlobalContext ;


(*
   EndGlobalContext - ends the dummy function for the global scope.
*)

PROCEDURE EndGlobalContext ;


END m2top.
------------------------
New file: gcc/m2/gm2-gcc/m2builtins.def
------------------------
(* m2builtins.def definition module for m2builtins.cc.

Copyright (C) 2003-2022 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 m2builtins ;

FROM SYSTEM IMPORT ADDRESS ;
FROM m2tree IMPORT Tree ;
FROM m2linemap IMPORT location_t ;

EXPORT QUALIFIED GetBuiltinConst, GetBuiltinConstType,
                 GetBuiltinTypeInfoType, GetBuiltinTypeInfo,
                 BuiltinExists, BuildBuiltinTree,
                 BuiltInMemCopy, BuiltInAlloca,
		 BuiltInIsfinite ;


(*
   GetBuiltinConst - returns the gcc tree of a built in constant, name.
                     NIL is returned if the constant is unknown.
*)

PROCEDURE GetBuiltinConst (name: ADDRESS) : Tree ;


(*
   GetBuiltinConstType - returns the type of a builtin constant, name.

                         0 = unknown constant name
                         1 = integer
                         2 = real
*)

PROCEDURE GetBuiltinConstType (name: ADDRESS) : CARDINAL ;



(*
   GetBuiltinTypeInfoType - returns value:
                            0    is ident is unknown.
                            1    if ident is IEC559, LIA1, ISO, IEEE, rounds, underflow,
                                             exception, extend.
                            2    if ident is radix, places, exponentmin, exponentmax,
                                             noofmodes.
                            3    if ident is large, small.
*)

PROCEDURE GetBuiltinTypeInfoType (ident: ADDRESS) : CARDINAL ;


(*
   GetBuiltinTypeInfo - returns a Tree value:

                        NULL_TREE        if ident is unknown.
                        boolean Tree     if ident is IEC559, LIA1, ISO, IEEE, rounds, underflow,
                                         exception, extend.
                        ZType Tree       if ident is radix, places, exponentmin, exponentmax,
                                         noofmodes.
                        RType Tree       if ident is large, small.
*)

PROCEDURE GetBuiltinTypeInfo (location: location_t; type: Tree; ident: ADDRESS) : Tree ;


(*
   BuiltinExists - returns TRUE if the builtin function, name, exists
                   for this target architecture.
*)

PROCEDURE BuiltinExists (name: ADDRESS) : BOOLEAN ;


(*
   BuildBuiltinTree - returns a Tree containing the builtin function, name.
*)

PROCEDURE BuildBuiltinTree (location: location_t; name: ADDRESS) : Tree ;


(*
   BuiltinMemCopy and BuiltinAlloca - are called by M2GenGCC to implement open arrays.
*)

PROCEDURE BuiltInMemCopy (location: location_t; dest, src, n: Tree) : Tree ;


(*
   BuiltInAlloca - given an expression, n, allocate, n, bytes on the stack for the life
                   of the current function.
*)

PROCEDURE BuiltInAlloca (location: location_t; n: Tree) : Tree ;


(*
   BuiltInIsfinite - given an expression, e, return an integer Tree of 1 if the
                     value is finite.  Return an integer Tree 0 if the value is
                     not finite.
*)

PROCEDURE BuiltInIsfinite (location: location_t; e: Tree) : Tree ;


END m2builtins.
------------------------
New file: gcc/m2/gm2-gcc/m2linemap.def
------------------------
(* m2linemap.def provides access to GCC location_t.

Copyright (C) 2011-2022 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 FOR "C" m2linemap ;

FROM SYSTEM IMPORT ADDRESS ;

EXPORT QUALIFIED StartFile, EndFile, StartLine, GetLocationColumn, GetLocationRange,
                 GetLocationBinary, UnknownLocation, BuiltinsLocation,
                 GetLineNoFromLocation, GetColumnNoFromLocation,
                 GetFilenameFromLocation, ErrorAt, ErrorAtf,
                 WarningAtf, NoteAtf, internal_error, location_t ;

TYPE
   location_t = INTEGER ;


PROCEDURE StartFile (filename: ADDRESS; linebegin: CARDINAL) ;
PROCEDURE EndFile ;
PROCEDURE StartLine (linenumber: CARDINAL; linesize: CARDINAL) ;
PROCEDURE GetLocationColumn (column: CARDINAL) : location_t ;
PROCEDURE GetLocationRange (start, end: CARDINAL) : location_t ;
PROCEDURE GetLocationBinary (caret, left, right: location_t) : location_t ;

PROCEDURE UnknownLocation () : location_t ;
PROCEDURE BuiltinsLocation () : location_t ;

PROCEDURE GetLineNoFromLocation (location: location_t) : INTEGER ;
PROCEDURE GetColumnNoFromLocation (location: location_t) : INTEGER ;
PROCEDURE GetFilenameFromLocation (location: location_t) : ADDRESS ;
PROCEDURE ErrorAt (location: location_t; message: ADDRESS) ;
(*
PROCEDURE ErrorAtf (location: location_t; message: ADDRESS; ...) ;
PROCEDURE WarningAtf (location: location_t; message: ADDRESS; ...) ;
PROCEDURE NoteAtf (location: location_t; message: ADDRESS; ...) ;
*)
PROCEDURE ErrorAtf (location: location_t; message: ADDRESS) ;
PROCEDURE WarningAtf (location: location_t; message: ADDRESS) ;
PROCEDURE NoteAtf (location: location_t; message: ADDRESS) ;
PROCEDURE internal_error (message: ADDRESS) ;


END m2linemap.
------------------------
New file: gcc/m2/gm2-gcc/m2except.def
------------------------
(* m2except.def provides an interface to build exception trees.

Copyright (C) 2008-2022 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 m2except ;

FROM m2tree IMPORT Tree ;
FROM m2linemap IMPORT location_t ;


(*
   InitExceptions - initialize this module, it declares the
                    external functions and assigns them to
                    the appropriate global tree variables.
*)

PROCEDURE InitExceptions (location: location_t) ;


(*
   BuildThrow - builds a throw statement and return the tree.
*)

PROCEDURE BuildThrow (location: location_t; t: Tree) : Tree ;


(*
    BuildTryBegin - returns a tree representing the 'try' block.
*)

PROCEDURE BuildTryBegin (location: location_t) : Tree ;


(*
   BuildTryEnd - builds the end of the Try block and prepares
                 for the catch handlers.
*)

PROCEDURE BuildTryEnd (tryBlock: Tree) ;


(*
   BuildCatchBegin - creates a handler tree for the C++
                     statement 'catch (...) {'.
                     It returns the handler tree.
*)

PROCEDURE BuildCatchBegin (location: location_t) : Tree ;


(*
   BuildCatchEnd - completes a try catch block.
                   It returns the, try_block, tree.
                   It creates the C++ statement

                   '}' which matches the catch above.
*)

PROCEDURE BuildCatchEnd (location: location_t; handler, tryBlock: Tree) : Tree ;


END m2except.
------------------------
New file: gcc/m2/gm2-gcc/init.def
------------------------
(* init.def provides procedures for initialising the m2 front end.

Copyright (C) 2012-2022 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 init ;

FROM SYSTEM IMPORT ADDRESS ;


(*
   FrontEndInit - initialise the modules, this is a global initialisation.
                  This is called once.
*)

PROCEDURE FrontEndInit ;


(*
   PerCompilationInit - initialise the modules before compiling, filename.
                        This is to be called every time we compile a new file.
*)

PROCEDURE PerCompilationInit (filename: ADDRESS) ;


END init.
------------------------
New file: gcc/m2/gm2-gcc/m2misc.def
------------------------
(* m2misc.def definition module for m2misc.cc.

Copyright (C) 2011-2022 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 m2misc ;

FROM m2tree IMPORT Tree ;

PROCEDURE DebugTree (t: Tree) ;


END m2misc.
------------------------
New file: gcc/m2/gm2-gcc/m2treelib.def
------------------------
(* m2treelib.def definition module for m2treelib.cc.

Copyright (C) 2011-2022 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 FOR "C" m2treelib ;

FROM m2tree IMPORT Tree ;
FROM m2linemap IMPORT location_t ;
FROM SYSTEM IMPORT ADDRESS ;

TYPE
   tree_code = INTEGER ;


(*
    get_set_address_if_var - returns the address of, op, providing
                             it is not a constant.
                             NULL is returned if, op, is a constant.
*)

PROCEDURE get_set_address_if_var (location: location_t; op: Tree; is_lvalue: INTEGER; is_const: INTEGER) : Tree ;


(*
    get_set_field_rhs - returns the value of p->field.
*)

PROCEDURE get_set_field_rhs (location: location_t; p: Tree; field: Tree) : Tree ;


(*
    get_set_field_lhs - returns the address of p->field.
*)

PROCEDURE get_set_field_lhs (location: location_t; p: Tree; field: Tree) : Tree ;


(*
    get_set_address - returns the address of op1.
*)

PROCEDURE get_set_address (location: location_t; op1: Tree; is_lvalue: INTEGER) : Tree ;


(*
    get_set_value - returns the value indicated by, field, in the set.
                    Either p->field or the constant(op.fieldNo) is returned.
*)

PROCEDURE get_set_value (location: location_t; p: Tree; field: Tree; is_const: INTEGER; op: Tree; fieldNo: CARDINAL) : Tree ;


(*
    get_field_no - returns the field no for, op.  The, op, is either
                   a constructor or a variable of type record.
                   If, op, is a constructor (a set constant in GNU Modula-2)
                   then this function is essentially a no-op and it returns op.
                   Else we iterate over the field list and return the
                   appropriate field number.
*)

PROCEDURE get_field_no (type: Tree; op: Tree; is_const: INTEGER; fieldNo: CARDINAL) : Tree ;


(*
    get_rvalue - returns the rvalue of t. The, type, is the object type to be
                 copied upon indirection.
*)

PROCEDURE get_rvalue (location: location_t; t: Tree; type: Tree; is_lvalue: INTEGER) : Tree ;


(*
    DoCall - build a call tree arranging the parameter list as a vector.
*)

PROCEDURE DoCall (location: location_t; rettype: Tree; funcptr: Tree; param_list: Tree) : Tree ;



PROCEDURE build_modify_expr (location: location_t; des: Tree; modifycode: tree_code; copy: Tree) : Tree ;


(*
    do_jump_if_bit - tests bit in word against integer zero using operator, code.
                     If the result is true then jump to label.
*)

PROCEDURE do_jump_if_bit (location: location_t; code: tree_code; word: Tree; bit: Tree; label: ADDRESS) ;


END m2treelib.

^ permalink raw reply	[flat|nested] only message in thread

only message in thread, other threads:[~2022-05-18 13:46 UTC | newest]

Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-05-18 13:45 [PATCH] Modula-2: merge proposal/review: 6/9 06.patch-set-04-3 Gaius Mulley

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).