mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-04-06 18:02:25 +00:00
353 lines
9.6 KiB
Modula-2
353 lines
9.6 KiB
Modula-2
(* Ulm's Oberon Library
|
|
Copyright (C) 1989-1997 by University of Ulm, SAI, D-89069 Ulm, Germany
|
|
----------------------------------------------------------------------------
|
|
Ulm's Oberon Library is free software; you can redistribute it
|
|
and/or modify it under the terms of the GNU Library General Public
|
|
License as published by the Free Software Foundation; either version
|
|
2 of the License, or (at your option) any later version.
|
|
|
|
Ulm's Oberon Library 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
|
|
Library General Public License for more details.
|
|
|
|
You should have received a copy of the GNU Library General Public
|
|
License along with this library; if not, write to the Free Software
|
|
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
----------------------------------------------------------------------------
|
|
E-mail contact: oberon@mathematik.uni-ulm.de
|
|
----------------------------------------------------------------------------
|
|
$Id: IntOperatio.om,v 1.1 1997/04/03 09:38:51 borchert Exp $
|
|
----------------------------------------------------------------------------
|
|
$Log: IntOperatio.om,v $
|
|
Revision 1.1 1997/04/03 09:38:51 borchert
|
|
Initial revision
|
|
|
|
----------------------------------------------------------------------------
|
|
*)
|
|
|
|
MODULE ulmIntOperations; (* Frank B.J. Fischer *)
|
|
|
|
IMPORT Operations := ulmOperations, PersistentObjects := ulmPersistentObjects, Services := ulmServices, Streams := ulmStreams, Types := ulmTypes, SYSTEM;
|
|
|
|
(* SYSTEM added to make casts necessary to port ulm library because ulm compiler is not as strict (read it's wrong) as it had to be --noch *)
|
|
|
|
CONST
|
|
mod* = 5; pow* = 6; inc* = 7; dec* = 8; mmul* = 9; mpow* = 10;
|
|
odd* = 11; shift* = 12;
|
|
|
|
TYPE
|
|
Operation* = Operations.Operation; (* Operations.add..mpow *)
|
|
Operand* = POINTER TO OperandRec;
|
|
|
|
TYPE
|
|
CapabilitySet* = Operations.CapabilitySet;
|
|
(* SET of [Operations.add..shift] *)
|
|
IsLargeEnoughForProc* = PROCEDURE (op: Operations.Operand;
|
|
n: LONGINT): BOOLEAN;
|
|
UnsignedProc* = PROCEDURE (op: Operations.Operand): BOOLEAN;
|
|
IntToOpProc* = PROCEDURE (int32: Types.Int32; VAR op: Operations.Operand);
|
|
OpToIntProc* = PROCEDURE (op: Operations.Operand; VAR int32: Types.Int32);
|
|
Log2Proc* = PROCEDURE (op: Operations.Operand): LONGINT;
|
|
OddProc* = PROCEDURE (op: Operations.Operand): BOOLEAN;
|
|
ShiftProc* = PROCEDURE (op: Operations.Operand;
|
|
n: INTEGER): Operations.Operand;
|
|
IntOperatorProc* = PROCEDURE(op: Operation;
|
|
op1, op2, op3: Operations.Operand;
|
|
VAR result: Operations.Operand);
|
|
Interface* = POINTER TO InterfaceRec;
|
|
InterfaceRec* = RECORD
|
|
(Operations.InterfaceRec)
|
|
isLargeEnoughFor*: IsLargeEnoughForProc;
|
|
unsigned* : UnsignedProc;
|
|
intToOp* : IntToOpProc;
|
|
opToInt* : OpToIntProc;
|
|
log2* : Log2Proc;
|
|
odd* : OddProc;
|
|
shift* : ShiftProc;
|
|
intOp* : IntOperatorProc;
|
|
END;
|
|
|
|
TYPE
|
|
OperandRec* = RECORD
|
|
(Operations.OperandRec);
|
|
(* private components *)
|
|
if : Interface;
|
|
caps: CapabilitySet;
|
|
END;
|
|
|
|
VAR
|
|
operandType: Services.Type;
|
|
|
|
|
|
PROCEDURE Init*(op: Operand; if: Interface; caps: CapabilitySet);
|
|
BEGIN
|
|
Operations.Init(op, if, caps);
|
|
op.if := if;
|
|
op.caps := caps;
|
|
END Init;
|
|
|
|
|
|
PROCEDURE Capabilities*(op: Operand): CapabilitySet;
|
|
BEGIN
|
|
RETURN op.caps
|
|
END Capabilities;
|
|
|
|
|
|
PROCEDURE IsLargeEnoughFor*(op: Operations.Operand; n: LONGINT): BOOLEAN;
|
|
BEGIN
|
|
WITH op: Operand DO
|
|
RETURN op.if.isLargeEnoughFor(op, n)
|
|
END;
|
|
END IsLargeEnoughFor;
|
|
|
|
|
|
PROCEDURE Unsigned*(op: Operations.Operand): BOOLEAN;
|
|
BEGIN
|
|
WITH op: Operand DO
|
|
RETURN op.if.unsigned(op)
|
|
END;
|
|
END Unsigned;
|
|
|
|
|
|
PROCEDURE IntToOp*(int32: Types.Int32; VAR op: Operations.Operand);
|
|
(* converts int32 into operand type, and stores result in already
|
|
initialized op
|
|
*)
|
|
BEGIN
|
|
(*WITH op: Operand DO*)
|
|
(*
|
|
with original ulm source we were getting:
|
|
|
|
WITH op: Operand DO
|
|
^
|
|
pos 4101 err 245 guarded pointer variable may be manipulated by non-local operations; use auxiliary pointer variable
|
|
|
|
thus we considered changing WITH op: Operand by op(Operand)
|
|
|
|
-- noch
|
|
|
|
*)
|
|
(*ASSERT(op.if # NIL);*)
|
|
ASSERT(op(Operand).if # NIL);
|
|
(*op.if.intToOp(int32, op);*)
|
|
op(Operand).if.intToOp(int32, op(Operations.Operand));
|
|
(*END;*)
|
|
END IntToOp;
|
|
|
|
|
|
PROCEDURE OpToInt*(op: Operations.Operand; VAR int32: Types.Int32);
|
|
(* converts op into int32 *)
|
|
BEGIN
|
|
WITH op: Operand DO
|
|
op.if.opToInt(op, int32);
|
|
END;
|
|
END OpToInt;
|
|
|
|
|
|
PROCEDURE Log2*(op: Operations.Operand): LONGINT;
|
|
BEGIN
|
|
WITH op: Operand DO
|
|
RETURN op.if.log2(op)
|
|
END;
|
|
END Log2;
|
|
|
|
|
|
PROCEDURE Odd*(op: Operations.Operand): BOOLEAN;
|
|
BEGIN
|
|
WITH op: Operand DO
|
|
ASSERT(odd IN op.caps);
|
|
RETURN op.if.odd(op)
|
|
END;
|
|
END Odd;
|
|
|
|
|
|
PROCEDURE Op(op: Operation; op1, op2, op3: Operations.Operand;
|
|
VAR result: Operations.Operand);
|
|
VAR
|
|
tmpresult: Operations.Operand;
|
|
BEGIN
|
|
WITH op1: Operand DO
|
|
IF (op2#NIL) & (op3#NIL) THEN
|
|
ASSERT((op1.if = op2(Operand).if) &
|
|
(op2(Operand).if = op3(Operand).if));
|
|
ELSIF (op2#NIL) THEN
|
|
ASSERT(op1.if = op2(Operand).if);
|
|
END;
|
|
ASSERT(op IN op1.caps);
|
|
op1.if.create(tmpresult);
|
|
op1.if.intOp(op, op1, op2, op3, tmpresult);
|
|
result := tmpresult;
|
|
END;
|
|
END Op;
|
|
|
|
|
|
PROCEDURE Shift*(op1: Operations.Operand; n: INTEGER): Operations.Operand;
|
|
BEGIN
|
|
WITH op1: Operand DO
|
|
ASSERT(shift IN op1.caps);
|
|
RETURN op1.if.shift(op1,n);
|
|
END;
|
|
END Shift;
|
|
|
|
|
|
PROCEDURE Shift2*(VAR op1: Operations.Operand; n: INTEGER);
|
|
BEGIN
|
|
op1 := Shift(op1, n);
|
|
END Shift2;
|
|
|
|
|
|
PROCEDURE Shift3*(VAR result: Operations.Operand; op1: Operations.Operand;
|
|
n : INTEGER);
|
|
VAR
|
|
tmpresult: Operations.Operand;
|
|
BEGIN
|
|
WITH op1: Operand DO
|
|
op1.if.create(tmpresult);
|
|
tmpresult := Shift(op1, n);
|
|
result := tmpresult;
|
|
END;
|
|
END Shift3;
|
|
|
|
|
|
PROCEDURE Inc*(op1: Operations.Operand): Operations.Operand;
|
|
VAR
|
|
result: Operations.Operand;
|
|
BEGIN
|
|
result := NIL;
|
|
Op(inc,op1,NIL,NIL,result);
|
|
RETURN result
|
|
END Inc;
|
|
|
|
|
|
PROCEDURE Inc2*(VAR op1: Operations.Operand);
|
|
BEGIN
|
|
Op(inc,op1,NIL,NIL,op1);
|
|
END Inc2;
|
|
|
|
|
|
PROCEDURE Inc3*(VAR result: Operations.Operand; op1: Operations.Operand);
|
|
BEGIN
|
|
Op(inc,op1,NIL,NIL,result);
|
|
END Inc3;
|
|
|
|
|
|
PROCEDURE Dec*(op1: Operations.Operand): Operations.Operand;
|
|
VAR
|
|
result: Operations.Operand;
|
|
BEGIN
|
|
result := NIL;
|
|
Op(dec,op1,NIL,NIL,result);
|
|
RETURN result
|
|
END Dec;
|
|
|
|
|
|
PROCEDURE Dec2*(VAR op1: Operations.Operand);
|
|
BEGIN
|
|
Op(dec,op1,NIL,NIL,op1);
|
|
END Dec2;
|
|
|
|
|
|
PROCEDURE Dec3*(VAR result: Operations.Operand; op1: Operations.Operand);
|
|
BEGIN
|
|
Op(dec,op1,NIL,NIL,result);
|
|
END Dec3;
|
|
|
|
|
|
PROCEDURE Mod*(op1, op2: Operations.Operand): Operations.Operand;
|
|
VAR
|
|
result: Operations.Operand;
|
|
BEGIN
|
|
result := NIL;
|
|
Op(mod, op1, op2, NIL, result);
|
|
RETURN result
|
|
END Mod;
|
|
|
|
|
|
PROCEDURE Mod2*(VAR op1: Operations.Operand; op2: Operations.Operand);
|
|
BEGIN
|
|
Op(mod, op1, op2, NIL, op1);
|
|
END Mod2;
|
|
|
|
|
|
PROCEDURE Mod3*(VAR result: Operations.Operand; op1, op2: Operations.Operand);
|
|
BEGIN
|
|
Op(mod, op1, op2, NIL, result);
|
|
END Mod3;
|
|
|
|
|
|
PROCEDURE Pow*(op1, op2: Operations.Operand): Operations.Operand;
|
|
VAR
|
|
result : Operand;
|
|
BEGIN
|
|
result := NIL;
|
|
(*Op(pow, op1, op2, NIL, result);*)
|
|
Op(pow, op1, op2, NIL, SYSTEM.VAL(Operations.Operand, result)); (* -- noch *)
|
|
RETURN result
|
|
END Pow;
|
|
|
|
|
|
PROCEDURE Pow2*(VAR op1: Operations.Operand; op2: Operations.Operand);
|
|
BEGIN
|
|
Op(pow, op1, op2, NIL, op1);
|
|
END Pow2;
|
|
|
|
|
|
PROCEDURE Pow3*(VAR result: Operations.Operand; op1, op2: Operations.Operand);
|
|
BEGIN
|
|
Op(pow, op1, op2, NIL, result);
|
|
END Pow3;
|
|
|
|
|
|
PROCEDURE MMul*(op1, op2, op3: Operations.Operand): Operations.Operand;
|
|
VAR
|
|
result : Operand;
|
|
BEGIN
|
|
result := NIL;
|
|
(*Op(mmul, op1, op2, op3, result); *)
|
|
Op(mmul, op1, op2, op3, SYSTEM.VAL(Operations.Operand, result)); (* --noch*)
|
|
RETURN result
|
|
END MMul;
|
|
|
|
|
|
PROCEDURE MMul2*(VAR op1: Operations.Operand; op2, op3: Operations.Operand);
|
|
BEGIN
|
|
Op(mmul, op1, op2, op3, op1);
|
|
END MMul2;
|
|
|
|
|
|
PROCEDURE MMul3*(VAR result: Operations.Operand;
|
|
op1, op2, op3: Operations.Operand);
|
|
BEGIN
|
|
Op(mmul, op1, op2, op3, result);
|
|
END MMul3;
|
|
|
|
|
|
PROCEDURE MPow*(op1, op2, op3: Operations.Operand): Operations.Operand;
|
|
VAR
|
|
result : Operand;
|
|
BEGIN
|
|
result := NIL;
|
|
(*Op(mpow, op1, op2, op3, result); *)
|
|
Op(mpow, op1, op2, op3, SYSTEM.VAL(Operations.Operand, result)); (* -- noch*)
|
|
RETURN result
|
|
END MPow;
|
|
|
|
|
|
PROCEDURE MPow2*(VAR op1: Operations.Operand; op2, op3: Operations.Operand);
|
|
BEGIN
|
|
Op(mpow, op1, op2, op3, op1);
|
|
END MPow2;
|
|
|
|
|
|
PROCEDURE MPow3*(VAR result: Operations.Operand;
|
|
op1, op2, op3: Operations.Operand);
|
|
BEGIN
|
|
Op(mpow, op1, op2, op3, result);
|
|
END MPow3;
|
|
|
|
|
|
BEGIN
|
|
PersistentObjects.RegisterType(operandType,"IntOperations.Operand",
|
|
"Operations.Operand", NIL);
|
|
END ulmIntOperations.
|