mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-04-06 00:32:24 +00:00
Norayr Chilingarian
parent
f9c6bc3a30
commit
aae8083ca2
1 changed files with 234 additions and 0 deletions
234
src/lib/ulm/ulmOperations.Mod
Normal file
234
src/lib/ulm/ulmOperations.Mod
Normal file
|
|
@ -0,0 +1,234 @@
|
||||||
|
(* Ulm's Oberon Library
|
||||||
|
Copyright (C) 1989-1994 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: Operations.om,v 1.4 2004/09/16 18:31:54 borchert Exp $
|
||||||
|
----------------------------------------------------------------------------
|
||||||
|
$Log: Operations.om,v $
|
||||||
|
Revision 1.4 2004/09/16 18:31:54 borchert
|
||||||
|
optimization for Assign added in case of a non-NIL target
|
||||||
|
and identical types for target and source
|
||||||
|
|
||||||
|
Revision 1.3 1997/02/05 16:27:45 borchert
|
||||||
|
Init asserts now that Services.Init hat been called previously
|
||||||
|
for ``op''
|
||||||
|
|
||||||
|
Revision 1.2 1995/01/16 21:39:50 borchert
|
||||||
|
- assertions of Assertions have been converted into real assertions
|
||||||
|
- some fixes due to changes of PersistentObjects
|
||||||
|
|
||||||
|
Revision 1.1 1994/02/22 20:09:03 borchert
|
||||||
|
Initial revision
|
||||||
|
|
||||||
|
----------------------------------------------------------------------------
|
||||||
|
AFB 12/91
|
||||||
|
----------------------------------------------------------------------------
|
||||||
|
*)
|
||||||
|
|
||||||
|
MODULE Operations;
|
||||||
|
|
||||||
|
(* generic support of arithmetic operations *)
|
||||||
|
|
||||||
|
IMPORT Events, Objects, PersistentDisciplines, PersistentObjects, Services;
|
||||||
|
|
||||||
|
CONST
|
||||||
|
add* = 0; sub* = 1; mul* = 2; div* = 3; cmp* = 4;
|
||||||
|
TYPE
|
||||||
|
Operation* = SHORTINT; (* add..cmp *)
|
||||||
|
Operand* = POINTER TO OperandRec;
|
||||||
|
|
||||||
|
TYPE
|
||||||
|
CapabilitySet* = SET; (* SET OF [add..cmp] *)
|
||||||
|
CreateProc* = PROCEDURE (VAR op: Operand);
|
||||||
|
(* should call Operations.Init for op *)
|
||||||
|
OperatorProc* = PROCEDURE (op: Operation; op1, op2: Operand;
|
||||||
|
VAR result: Operand);
|
||||||
|
AssignProc* = PROCEDURE (VAR target: Operand; source: Operand);
|
||||||
|
CompareProc* = PROCEDURE (op1, op2: Operand) : INTEGER;
|
||||||
|
Interface* = POINTER TO InterfaceRec;
|
||||||
|
InterfaceRec* =
|
||||||
|
RECORD
|
||||||
|
(Objects.ObjectRec)
|
||||||
|
create*: CreateProc;
|
||||||
|
assign*: AssignProc;
|
||||||
|
op*: OperatorProc;
|
||||||
|
compare*: CompareProc;
|
||||||
|
END;
|
||||||
|
|
||||||
|
TYPE
|
||||||
|
OperandRec* =
|
||||||
|
RECORD
|
||||||
|
(PersistentDisciplines.ObjectRec)
|
||||||
|
if: Interface;
|
||||||
|
caps: CapabilitySet;
|
||||||
|
END;
|
||||||
|
VAR
|
||||||
|
operandType: Services.Type;
|
||||||
|
|
||||||
|
PROCEDURE Init*(op: Operand; if: Interface; caps: CapabilitySet);
|
||||||
|
VAR
|
||||||
|
type: Services.Type;
|
||||||
|
BEGIN
|
||||||
|
Services.GetType(op, type); ASSERT(type # NIL);
|
||||||
|
op.if := if; op.caps := caps;
|
||||||
|
END Init;
|
||||||
|
|
||||||
|
PROCEDURE Capabilities*(op: Operand) : CapabilitySet;
|
||||||
|
BEGIN
|
||||||
|
RETURN op.caps
|
||||||
|
END Capabilities;
|
||||||
|
|
||||||
|
PROCEDURE Compatible*(op1, op2: Operand) : BOOLEAN;
|
||||||
|
(* return TRUE if both operands have the same interface *)
|
||||||
|
BEGIN
|
||||||
|
RETURN op1.if = op2.if
|
||||||
|
END Compatible;
|
||||||
|
|
||||||
|
(* the interface of the first operand must match the interface
|
||||||
|
of all other operands;
|
||||||
|
the result parameter must be either NIL or already initialized
|
||||||
|
with the same interface
|
||||||
|
*)
|
||||||
|
|
||||||
|
PROCEDURE Op(op: Operation; op1, op2: Operand; VAR result: Operand);
|
||||||
|
|
||||||
|
VAR
|
||||||
|
tmpresult: Operand;
|
||||||
|
BEGIN
|
||||||
|
ASSERT(op1.if = op2.if);
|
||||||
|
ASSERT(op IN op1.caps);
|
||||||
|
(* we are very defensive here because the type of tmpresult
|
||||||
|
is perhaps not identical to result or an extension of it;
|
||||||
|
op1.if.create(result) will not work in all cases
|
||||||
|
because of type guard failures
|
||||||
|
*)
|
||||||
|
op1.if.create(tmpresult);
|
||||||
|
op1.if.op(op, op1, op2, tmpresult);
|
||||||
|
result := tmpresult;
|
||||||
|
END Op;
|
||||||
|
|
||||||
|
PROCEDURE Add*(op1, op2: Operand) : Operand;
|
||||||
|
VAR result: Operand;
|
||||||
|
BEGIN
|
||||||
|
result := NIL;
|
||||||
|
Op(add, op1, op2, result);
|
||||||
|
RETURN result
|
||||||
|
END Add;
|
||||||
|
|
||||||
|
PROCEDURE Add2*(VAR op1: Operand; op2: Operand);
|
||||||
|
BEGIN
|
||||||
|
Op(add, op1, op2, op1);
|
||||||
|
END Add2;
|
||||||
|
|
||||||
|
PROCEDURE Add3*(VAR result: Operand; op1, op2: Operand);
|
||||||
|
BEGIN
|
||||||
|
Op(add, op1, op2, result);
|
||||||
|
END Add3;
|
||||||
|
|
||||||
|
PROCEDURE Sub*(op1, op2: Operand) : Operand;
|
||||||
|
VAR result: Operand;
|
||||||
|
BEGIN
|
||||||
|
result := NIL;
|
||||||
|
Op(sub, op1, op2, result);
|
||||||
|
RETURN result
|
||||||
|
END Sub;
|
||||||
|
|
||||||
|
PROCEDURE Sub2*(VAR op1: Operand; op2: Operand);
|
||||||
|
BEGIN
|
||||||
|
Op(sub, op1, op2, op1);
|
||||||
|
END Sub2;
|
||||||
|
|
||||||
|
PROCEDURE Sub3*(VAR result: Operand; op1, op2: Operand);
|
||||||
|
BEGIN
|
||||||
|
Op(sub, op1, op2, result);
|
||||||
|
END Sub3;
|
||||||
|
|
||||||
|
PROCEDURE Mul*(op1, op2: Operand) : Operand;
|
||||||
|
VAR result: Operand;
|
||||||
|
BEGIN
|
||||||
|
result := NIL;
|
||||||
|
Op(mul, op1, op2, result);
|
||||||
|
RETURN result
|
||||||
|
END Mul;
|
||||||
|
|
||||||
|
PROCEDURE Mul2*(VAR op1: Operand; op2: Operand);
|
||||||
|
BEGIN
|
||||||
|
Op(mul, op1, op2, op1);
|
||||||
|
END Mul2;
|
||||||
|
|
||||||
|
PROCEDURE Mul3*(VAR result: Operand; op1, op2: Operand);
|
||||||
|
BEGIN
|
||||||
|
Op(mul, op1, op2, result);
|
||||||
|
END Mul3;
|
||||||
|
|
||||||
|
PROCEDURE Div*(op1, op2: Operand) : Operand;
|
||||||
|
VAR result: Operand;
|
||||||
|
BEGIN
|
||||||
|
result := NIL;
|
||||||
|
Op(div, op1, op2, result);
|
||||||
|
RETURN result
|
||||||
|
END Div;
|
||||||
|
|
||||||
|
PROCEDURE Div2*(VAR op1: Operand; op2: Operand);
|
||||||
|
BEGIN
|
||||||
|
Op(div, op1, op2, op1);
|
||||||
|
END Div2;
|
||||||
|
|
||||||
|
PROCEDURE Div3*(VAR result: Operand; op1, op2: Operand);
|
||||||
|
BEGIN
|
||||||
|
Op(div, op1, op2, result);
|
||||||
|
END Div3;
|
||||||
|
|
||||||
|
PROCEDURE Compare*(op1, op2: Operand) : INTEGER;
|
||||||
|
BEGIN
|
||||||
|
ASSERT(op1.if = op2.if);
|
||||||
|
ASSERT(cmp IN op1.caps);
|
||||||
|
RETURN op1.if.compare(op1, op2)
|
||||||
|
END Compare;
|
||||||
|
|
||||||
|
PROCEDURE Assign*(VAR target: Operand; source: Operand);
|
||||||
|
VAR
|
||||||
|
tmpTarget: Operand;
|
||||||
|
typesIdentical: BOOLEAN;
|
||||||
|
targetType, sourceType: Services.Type;
|
||||||
|
BEGIN
|
||||||
|
IF (target # NIL) & (target.if = source.if) THEN
|
||||||
|
Services.GetType(target, targetType);
|
||||||
|
Services.GetType(source, sourceType);
|
||||||
|
typesIdentical := targetType = sourceType;
|
||||||
|
ELSE
|
||||||
|
typesIdentical := FALSE;
|
||||||
|
END;
|
||||||
|
IF typesIdentical THEN
|
||||||
|
source.if.assign(target, source);
|
||||||
|
ELSE
|
||||||
|
source.if.create(tmpTarget);
|
||||||
|
source.if.assign(tmpTarget, source);
|
||||||
|
target := tmpTarget;
|
||||||
|
END;
|
||||||
|
END Assign;
|
||||||
|
|
||||||
|
PROCEDURE Copy*(source, target: Operand);
|
||||||
|
BEGIN
|
||||||
|
source.if.assign(target, source);
|
||||||
|
END Copy;
|
||||||
|
|
||||||
|
BEGIN
|
||||||
|
PersistentObjects.RegisterType(operandType,
|
||||||
|
"Operations.Operand", "PersistentDisciplines.Object", NIL);
|
||||||
|
END Operations.
|
||||||
Loading…
Add table
Add a link
Reference in a new issue