diff --git a/m3-tools/m3tk/src/target/M3CBackEnd_Int_Longint.i3 b/m3-tools/m3tk/src/target/M3CBackEnd_Int_Longint.i3 index 8f419dcf8b..8b97a0d994 100644 --- a/m3-tools/m3tk/src/target/M3CBackEnd_Int_Longint.i3 +++ b/m3-tools/m3tk/src/target/M3CBackEnd_Int_Longint.i3 @@ -3,5 +3,5 @@ (* See the file COPYRIGHT for a full description. *) INTERFACE M3CBackEnd_Int_Longint = - M3CBackEnd_Int(Longint) + M3CBackEnd_Int_Longint_xg(Longint) END M3CBackEnd_Int_Longint. diff --git a/m3-tools/m3tk/src/target/M3CBackEnd_Int_Longint.m3 b/m3-tools/m3tk/src/target/M3CBackEnd_Int_Longint.m3 index d6ba8a670d..b7615ee253 100644 --- a/m3-tools/m3tk/src/target/M3CBackEnd_Int_Longint.m3 +++ b/m3-tools/m3tk/src/target/M3CBackEnd_Int_Longint.m3 @@ -3,5 +3,5 @@ (* See the file COPYRIGHT for a full description. *) MODULE M3CBackEnd_Int_Longint = - M3CBackEnd_Int(Longint, Long) + M3CBackEnd_Int_Longint_xg(Longint, Long) END M3CBackEnd_Int_Longint. diff --git a/m3-tools/m3tk/src/target/M3CBackEnd_Int_Longint_xg.ig b/m3-tools/m3tk/src/target/M3CBackEnd_Int_Longint_xg.ig new file mode 100644 index 0000000000..97309fe7c0 --- /dev/null +++ b/m3-tools/m3tk/src/target/M3CBackEnd_Int_Longint_xg.ig @@ -0,0 +1,51 @@ +GENERIC INTERFACE M3CBackEnd_Int_Longint_xg(IntType); + +(* Copyright (C) 1991, Digital Equipment Corporation *) +(* All rights reserved. *) +(* See the file COPYRIGHT for a full description. *) + +IMPORT M3AST_AS, M3AST_SM, M3CStdProcs, M3CBackEnd, M3CWordProcs; + +REVEAL M3AST_SM.Exp_value <: ROOT; + +TYPE T = M3AST_SM.Exp_value BRANDED OBJECT sm_value: IntType.T END; + +PROCEDURE New_value(r: IntType.T): T RAISES {}; + +PROCEDURE StdUnaryOp( + f: M3CStdProcs.Func; + e: T; + VAR (*out*) er: M3AST_SM.Exp_value; + it: M3AST_AS.INT_TYPE := NIL; + ft: M3AST_AS.FLOAT_TYPE := NIL + ): M3CBackEnd.NumStatus RAISES {}; + +PROCEDURE StdBinaryOp( + f: M3CStdProcs.Func; + e1, e2: T; + VAR (*out*) er: M3AST_SM.Exp_value) + : M3CBackEnd.NumStatus + RAISES {}; + +PROCEDURE UnaryOp( + op: M3AST_AS.UNARY; + e: T; + VAR (*out*) er: M3AST_SM.Exp_value) + : M3CBackEnd.NumStatus + RAISES {}; + +PROCEDURE BinaryOp( + op: M3AST_AS.BINARY; + e1, e2: T; + VAR (*out*) er: M3AST_SM.Exp_value) + : M3CBackEnd.NumStatus + RAISES {}; + +PROCEDURE WordOp( + w: M3CWordProcs.T; + READONLY args: ARRAY OF M3AST_SM.Exp_value; + VAR (* out *) er: M3AST_SM.Exp_value) + : M3CBackEnd.NumStatus + RAISES {}; + +END M3CBackEnd_Int_Longint_xg. diff --git a/m3-tools/m3tk/src/target/M3CBackEnd_Int_Longint_xg.mg b/m3-tools/m3tk/src/target/M3CBackEnd_Int_Longint_xg.mg new file mode 100644 index 0000000000..bb7e427731 --- /dev/null +++ b/m3-tools/m3tk/src/target/M3CBackEnd_Int_Longint_xg.mg @@ -0,0 +1,218 @@ +GENERIC MODULE M3CBackEnd_Int_Longint_xg(IntType, WordType); + +(* Copyright (C) 1991, Digital Equipment Corporation *) +(* All rights reserved. *) +(* See the file COPYRIGHT for a full description. *) + +IMPORT M3AST_AS, M3AST_SM, M3CStdProcs; + +IMPORT M3CBackEnd, M3CBackEnd_C, M3CWordProcs; +IMPORT M3CBackEnd_Float_Real, M3CBackEnd_Float_LongReal, + M3CBackEnd_Float_Extended; +IMPORT M3CBackEnd_Int_Integer AS Integer; + +CONST + False = VAL(ORD(FALSE), IntType.T); + True = VAL(ORD(TRUE), IntType.T); + Zero = VAL(0, IntType.T); + +VAR + small_of_M3CBackEnd_Int_Longint_xg := ARRAY [0..255] OF T {NIL, ..}; + first := NEW(T, sm_value := FIRST(IntType.T)); + last := NEW(T, sm_value := LAST(IntType.T)); + +PROCEDURE New_value(i: IntType.T): T RAISES {} = + BEGIN + IF VAL(FIRST(small_of_M3CBackEnd_Int_Longint_xg), IntType.T) <= i + AND i <= VAL(LAST(small_of_M3CBackEnd_Int_Longint_xg), IntType.T) THEN + WITH result = small_of_M3CBackEnd_Int_Longint_xg[VAL(i, INTEGER)] DO + IF result = NIL THEN result := NEW(T, sm_value := i) END; + RETURN result; + END; + ELSIF i = FIRST(IntType.T) THEN RETURN first; + ELSIF i = LAST(IntType.T) THEN RETURN last; + ELSE RETURN NEW(T, sm_value := i); + END; + END New_value; + +PROCEDURE UnaryOp( + op: M3AST_AS.UNARY; + e: T; + VAR (*out*) er: M3AST_SM.Exp_value) + : M3CBackEnd.NumStatus RAISES {} = + BEGIN + TYPECASE op OF + | M3AST_AS.Unaryplus => + er := New_value(e.sm_value); + | M3AST_AS.Unaryminus => + er := New_value(-e.sm_value); + | M3AST_AS.Not => + er := Integer.New_value(ORD(e.sm_value = False)); + ELSE + RETURN M3CBackEnd.NumStatus.Unknown; + END; (* case *) + RETURN M3CBackEnd.NumStatus.Valid; + END UnaryOp; + +PROCEDURE StdUnaryOp( + f: M3CStdProcs.Func; + e: T; + VAR (*out*) er: M3AST_SM.Exp_value; + <*UNUSED*> it: M3AST_AS.INT_TYPE := NIL; + ft: M3AST_AS.FLOAT_TYPE := NIL) + : M3CBackEnd.NumStatus RAISES {} = + VAR + int: IntType.T := e.sm_value; + BEGIN + CASE f OF + | M3CStdProcs.T.Abs => + er := New_value(ABS(int)); + | M3CStdProcs.T.Float => + TYPECASE ft OF <*NOWARN*> + | M3AST_AS.Real_type => + er := M3CBackEnd_Float_Real.New_value(FLOAT(int, REAL)); + | M3AST_AS.LongReal_type => + er := M3CBackEnd_Float_LongReal.New_value(FLOAT(int, LONGREAL)); + | M3AST_AS.Extended_type => + er := M3CBackEnd_Float_Extended.New_value(FLOAT(int, EXTENDED)); + END; (* typecase *) + ELSE + RETURN M3CBackEnd.NumStatus.Unknown; + END; (* case *) + RETURN M3CBackEnd.NumStatus.Valid; + END StdUnaryOp; + +PROCEDURE BinaryOp( + op: M3AST_AS.BINARY; + e1, e2: T; + VAR (*out*) er: M3AST_SM.Exp_value) + : M3CBackEnd.NumStatus RAISES {} = + VAR + i1 := e1.sm_value; + i2 := e2.sm_value; + r: IntType.T; + bool: BOOLEAN; + BEGIN + TYPECASE op OF + | M3AST_AS.Plus => r := i1 + i2; + | M3AST_AS.Minus => r := i1 - i2; + | M3AST_AS.Times => r := i1 * i2; + | M3AST_AS.Div => + IF i2 = Zero THEN RETURN M3CBackEnd.NumStatus.Overflow END; + r := i1 DIV i2; + | M3AST_AS.Mod => + IF i2 = Zero THEN RETURN M3CBackEnd.NumStatus.Overflow END; + r := i1 MOD i2; + ELSE + TYPECASE op OF + | M3AST_AS.Eq => bool := i1 = i2; + | M3AST_AS.Ne => bool := i1 # i2; + | M3AST_AS.Gt => bool := i1 > i2; + | M3AST_AS.Lt => bool := i1 < i2; + | M3AST_AS.Ge => bool := i1 >= i2; + | M3AST_AS.Le => bool := i1 <= i2; + | M3AST_AS.And => bool := (i1 = True) AND (i2 = True); + | M3AST_AS.Or => bool := (i1 = True) OR (i2 = True); + ELSE RETURN M3CBackEnd.NumStatus.Unknown; + END; (* case *) + er := Integer.New_value(ORD(bool)); + RETURN M3CBackEnd.NumStatus.Valid; + END; + er := New_value(r); + RETURN M3CBackEnd.NumStatus.Valid; + END BinaryOp; + +PROCEDURE StdBinaryOp(f: M3CStdProcs.Func; + e1, e2: T; + VAR (*out*) er: M3AST_SM.Exp_value) + : M3CBackEnd.NumStatus RAISES {} = + BEGIN + CASE f OF <*NOWARN*> + | M3CStdProcs.T.Min => + IF e1.sm_value < e2.sm_value + THEN er := e1; + ELSE er := e2; + END; + | M3CStdProcs.T.Max => + IF e1.sm_value > e2.sm_value + THEN er := e1; + ELSE er := e2; + END; + END; (* case *) + RETURN M3CBackEnd.NumStatus.Valid; + END StdBinaryOp; + +PROCEDURE WordOp( + w: M3CWordProcs.T; + READONLY args: ARRAY OF M3AST_SM.Exp_value; + VAR (* out *) er: M3AST_SM.Exp_value) + : M3CBackEnd.NumStatus RAISES {} = + VAR + a0 := NARROW(args[0], T).sm_value; + r: IntType.T; + bool: BOOLEAN; + BEGIN + CASE w OF + | M3CWordProcs.T.Not => r := WordType.Not(a0); + | M3CWordProcs.T.Plus => + r := WordType.Plus(a0, NARROW(args[1], T).sm_value); + | M3CWordProcs.T.Times => + r := WordType.Times(a0, NARROW(args[1], T).sm_value); + | M3CWordProcs.T.Minus => + r := WordType.Minus(a0, NARROW(args[1], T).sm_value); + | M3CWordProcs.T.Divide => + r := WordType.Divide(a0, NARROW(args[1], T).sm_value); + | M3CWordProcs.T.Mod => + r := WordType.Mod(a0, NARROW(args[1], T).sm_value); + | M3CWordProcs.T.And => + r := WordType.And(a0, NARROW(args[1], T).sm_value); + | M3CWordProcs.T.Or => + r := WordType.Or(a0, NARROW(args[1], T).sm_value); + | M3CWordProcs.T.Xor => + r := WordType.Xor(a0, NARROW(args[1], T).sm_value); + | M3CWordProcs.T.Shift => + r := WordType.Shift(a0, NARROW(args[1], Integer.T).sm_value); + | M3CWordProcs.T.RightShift => + r := WordType.RightShift(a0, NARROW(args[1], Integer.T).sm_value); + | M3CWordProcs.T.Rotate => + r := WordType.Rotate(a0, NARROW(args[1], Integer.T).sm_value); + | M3CWordProcs.T.RightRotate => + r := WordType.RightRotate(a0, NARROW(args[1], Integer.T).sm_value); + | M3CWordProcs.T.Extract => + WITH a1 = NARROW(args[1], Integer.T).sm_value, + a2 = NARROW(args[2], Integer.T).sm_value DO + IF a1 < 0 OR a2 < 0 OR a1 + a2 > WordType.Size THEN + RETURN M3CBackEnd.NumStatus.Unknown; + END; + r := WordType.Extract(a0, a1, a2); + END; + | M3CWordProcs.T.Insert => + WITH a1 = NARROW(args[1], T).sm_value, + a2 = NARROW(args[2], Integer.T).sm_value, + a3 = NARROW(args[3], Integer.T).sm_value DO + IF a2 < 0 OR a3 < 0 OR a2 + a3 > WordType.Size THEN + RETURN M3CBackEnd.NumStatus.Unknown; + END; + r := WordType.Insert(a0, a1, a2, a3); + END; + ELSE + CASE w OF + | M3CWordProcs.T.LT => + bool := WordType.LT(a0, NARROW(args[1], T).sm_value); + | M3CWordProcs.T.LE => + bool := WordType.LE(a0, NARROW(args[1], T).sm_value); + | M3CWordProcs.T.GT => + bool := WordType.GT(a0, NARROW(args[1], T).sm_value); + | M3CWordProcs.T.GE => + bool := WordType.GE(a0, NARROW(args[1], T).sm_value); + ELSE RETURN M3CBackEnd.NumStatus.Unknown; + END; + er := Integer.New_value(ORD(bool)); + RETURN M3CBackEnd.NumStatus.Valid; + END; + er := New_value(r); + RETURN M3CBackEnd.NumStatus.Valid; + END WordOp; + +BEGIN +END M3CBackEnd_Int_Longint_xg. diff --git a/m3-tools/m3tk/src/target/m3makefile b/m3-tools/m3tk/src/target/m3makefile index aad086bb09..4ec821437c 100644 --- a/m3-tools/m3tk/src/target/m3makefile +++ b/m3-tools/m3tk/src/target/m3makefile @@ -15,6 +15,7 @@ Interface("M3CBE_C_Tool") Interface("M3CBackEnd_C_cc") Generic_interface("M3CBackEnd_Int") Interface("M3CBackEnd_Int_Integer") +Generic_interface("M3CBackEnd_Int_Longint_xg") Interface("M3CBackEnd_Int_Longint") Generic_interface("M3CBackEnd_Float") Interface("M3CBackEnd_Float_Extended") @@ -31,6 +32,7 @@ implementation("M3CBE_C_i386") implementation("M3CBE_C_amd64") generic_implementation("M3CBackEnd_Int") implementation("M3CBackEnd_Int_Integer") +generic_implementation("M3CBackEnd_Int_Longint_xg") implementation("M3CBackEnd_Int_Longint") generic_implementation("M3CBackEnd_Float") implementation("M3CBackEnd_Float_Extended")