![[ModulaWare, 2.5KB]](modulw.gif)
MODULE Test_Put;
(* Meta-programming example
written in absolutely non-magic Oberon-2
by Guenter Dotzel, mailto:modulaware@altavista.net
http://www.modulaware.com/
30-Oct-1997
The imported module Put is also written in non-magic Oberon-2
using the meta-programming module Ref.
For a description of module Ref and Put, see
"Metaprogramming Facilities in Oberon"
by Christopf Steindl and Hanspeter Moessenboeck
Report 8 available in PostScript format
at ftp://ftp.ssw.uni-linz.ac.at/pub/Reports
and
"Metaprogramming in Oberon"
by Josef Templ, ETHZ-dissertation No. 10655, 1994
available in PostScript format at ftp://ftp.inf.ethz.ch
The command "Test_Put.Do" produces the output below when run on a
64 bit Digital Alpha under OpenVMS. This program will also run with any
Oberon System V4 from University Linz (Austria) on PC or PowerMac,
only that MAX(LONGINT) would be about 4 billion times smaller.
The Alpha Oberon interface modules for Put and Ref are appended below.
*)
IMPORT Put;
TYPE
R = POINTER TO RDesc;
RDesc = RECORD
a: LONGINT;
END;
VAR
globalString: ARRAY 10 OF CHAR;
globalInt: INTEGER;
r: R;
PROCEDURE Bar;
VAR bar: ARRAY 10 OF CHAR;
PROCEDURE T1(adr: LONGINT);
VAR x: LONGINT;
BEGIN
x := adr * 32;
Put.S("T1: x=#x adr=#adr bar=#bar globalString=#globalString");
Put.S(" globalInt=#globalInt$");
END T1;
PROCEDURE T2(adr: LONGINT);
VAR y: REAL;
BEGIN
y := adr + 32;
Put.S("T2: y=#y adr=#adr T1.x=#x bar=#bar globalString=#globalString");
Put.S(" globalInt=#globalInt$");
END T2;
BEGIN
bar := "foobar";
Put.S("Bar: y=#y adr=#adr bar=#bar globalString=#globalString");
Put.S(" globalInt=#globalInt$");
T1(20); T2(40); T1(50);
END Bar;
PROCEDURE Do*;
VAR i: LONGINT;
BEGIN
Bar; i:=3; Put.S
("r = #r; r.a = #r.a; r^ = #r^; $globalString [#i] = #globalString[i] ");
END Do;
BEGIN
globalString := "hartmut"; globalInt := 42;
NEW(r); r.a := MAX(LONGINT);
END Test_Put.
The result of executing the command Test_Put.Do
Bar: y= adr= bar=foobar globalString=hartmut globalInt=42
T1: x=640 adr=20 bar=foobar globalString=hartmut globalInt=42
T2: y= 7.20E+01 adr=40 T1.x= bar=foobar globalString=hartmut globalInt=42
T1: x=1600 adr=50 bar=foobar globalString=hartmut globalInt=42
r = 2147852992; r.a = 9223372036854775807; r^ = ;
globalString [3] = t
INTERFACE Put; (* 64-bit mode *)
PROCEDURE S (s: ARRAY OF CHAR);
END Put.
INTERFACE Ref; (* 64-bit mode *)
IMPORT
Modules, Types, VMSExceptions, SYSTEM;
CONST
Array = 48;
Bool = 6;
Byte = 1;
Card = 33;
Char = 7;
Comp = 32;
DComplx = 28;
DReal = 13;
DynArr = 49;
Elem = 3;
End = 0;
Enum = 35;
FComplx = 27;
FP = 29;
FReal = 12;
Fld = 4;
Frame = 5;
GComplx = 29;
GReal = 16;
HReal = 17;
Hide = 37;
Int = 9;
LInt = 10;
LReal = 15;
LSet = 19;
NilTyp = 21;
NoTyp = 22;
None = 0;
Octaword = 5;
Pointer = 23;
Proc = 6;
Procedure = 25;
QCard = 34;
QInt = 11;
QPointer = 24;
QProcedure = 26;
Quadword = 4;
Real = 14;
Record = 50;
SComplx = 30;
SInt = 8;
SP = 30;
SReal = 14;
Set = 18;
Shortword = 2;
String = 20;
SubRan = 36;
TComplx = 31;
TReal = 15;
Type = 7;
Var = 1;
VarPar = 2;
Word = 3;
bodyName = "%body%";
TYPE
#ExceptionInfo = POINTER TO VMSExceptions.InvoContext;
#HiddenBase = RECORD [8]
pos: LONGINT;
base: LONGINT;
m: Modules.Module;
type: Types.Type;
extType: Types.Type;
fp: LONGINT;
pc: LONGINT;
procDesc: LONGINT;
extLevel: SHORTINT;
elemSize: LONGINT;
lenAdr: LONGINT;
surrounding-: LONGINT;
info: #ExceptionInfo;
END ;
ProcVar = PROCEDURE ;
Rider = RECORD [8] (#HiddenBase)
name: ARRAY 32 OF CHAR;
mode: SHORTINT;
form: SHORTINT;
idx: LONGINT;
off: LONGINT;
len: LONGINT;
mod: ARRAY 32 OF CHAR;
level: SHORTINT;
PROCEDURE (VAR r: Rider) Adr(): LONGINT;
PROCEDURE (VAR r: Rider) Next;
PROCEDURE (VAR r: Rider) Read(VAR ch: CHAR);
PROCEDURE (VAR r: Rider) ReadBool(VAR b: BOOLEAN);
PROCEDURE (VAR r: Rider) ReadDReal(VAR x: SYSTEM.D_FLOATING);
PROCEDURE (VAR r: Rider) ReadFReal(VAR x: SYSTEM.F_FLOATING);
PROCEDURE (VAR r: Rider) ReadGReal(VAR x: SYSTEM.G_FLOATING);
PROCEDURE (VAR r: Rider) ReadHReal(VAR x: SYSTEM.G_FLOATING);
PROCEDURE (VAR r: Rider) ReadInt(VAR i: INTEGER);
PROCEDURE (VAR r: Rider) ReadLInt(VAR li: SYSTEM.SIGNED_32);
PROCEDURE (VAR r: Rider) ReadLSet(VAR s: LONGSET);
PROCEDURE (VAR r: Rider) ReadOctaword(VAR w: SYSTEM.OCTAWORD);
PROCEDURE (VAR r: Rider) ReadProc(VAR p: ProcVar);
PROCEDURE (VAR r: Rider) ReadPtr(VAR p: SYSTEM.PTR);
PROCEDURE (VAR r: Rider) ReadQInt(VAR li: LONGINT);
PROCEDURE (VAR r: Rider) ReadQuadword(VAR w: SYSTEM.QUADWORD);
PROCEDURE (VAR r: Rider) ReadSInt(VAR si: SHORTINT);
PROCEDURE (VAR r: Rider) ReadSReal(VAR x: REAL);
PROCEDURE (VAR r: Rider) ReadSet(VAR s: SET);
PROCEDURE (VAR r: Rider) ReadShortword(VAR w: SYSTEM.SHORTWORD);
PROCEDURE (VAR r: Rider) ReadString(VAR str: ARRAY OF CHAR);
PROCEDURE (VAR r: Rider) ReadTReal(VAR x: LONGREAL);
PROCEDURE (VAR r: Rider) ReadWord(VAR w: SYSTEM.LONGWORD);
PROCEDURE (VAR r: Rider) SetTo(idx: LONGINT);
PROCEDURE (VAR r: Rider) Type(): Types.Type;
PROCEDURE (VAR r: Rider) Write(ch: CHAR);
PROCEDURE (VAR r: Rider) WriteBool(b: BOOLEAN);
PROCEDURE (VAR r: Rider) WriteDReal(x: SYSTEM.D_FLOATING);
PROCEDURE (VAR r: Rider) WriteFReal(x: SYSTEM.F_FLOATING);
PROCEDURE (VAR r: Rider) WriteGReal(x: SYSTEM.G_FLOATING);
PROCEDURE (VAR r: Rider) WriteHReal(x: SYSTEM.G_FLOATING);
PROCEDURE (VAR r: Rider) WriteInt(i: INTEGER);
PROCEDURE (VAR r: Rider) WriteLInt(li: SYSTEM.SIGNED_32);
PROCEDURE (VAR r: Rider) WriteLSet(s: LONGSET);
PROCEDURE (VAR r: Rider) WriteOctaword(VAR w: SYSTEM.OCTAWORD);
PROCEDURE (VAR r: Rider) WriteProc(p: ProcVar);
PROCEDURE (VAR r: Rider) WritePtr(p: SYSTEM.PTR);
PROCEDURE (VAR r: Rider) WriteQInt(li: LONGINT);
PROCEDURE (VAR r: Rider) WriteQuadword(VAR w: SYSTEM.QUADWORD);
PROCEDURE (VAR r: Rider) WriteSInt(si: SHORTINT);
PROCEDURE (VAR r: Rider) WriteSReal(x: REAL);
PROCEDURE (VAR r: Rider) WriteSet(s: SET);
PROCEDURE (VAR r: Rider) WriteShortword(VAR w: SYSTEM.SHORTWORD);
PROCEDURE (VAR r: Rider) WriteString(str: ARRAY OF CHAR);
PROCEDURE (VAR r: Rider) WriteTReal(x: LONGREAL);
PROCEDURE (VAR r: Rider) WriteWord(VAR w: SYSTEM.LONGWORD);
PROCEDURE (VAR r: Rider) Zoom(VAR sub: Rider);
END ;
PROCEDURE FindProc(procDesc: LONGINT; pc: LONGINT; mod: ARRAY OF CHAR; name: ARRAY OF CHAR; VAR r: Rider);
PROCEDURE OpenProc(pc: LONGINT; VAR r: Rider);
PROCEDURE OpenProcs(mod: ARRAY OF CHAR; VAR r: Rider);
PROCEDURE OpenPtr(p: SYSTEM.PTR; VAR r: Rider);
PROCEDURE OpenStack(info: #ExceptionInfo; VAR r: Rider);
PROCEDURE OpenTypes(mod: ARRAY OF CHAR; VAR r: Rider);
PROCEDURE OpenVars(mod: ARRAY OF CHAR; VAR r: Rider);
PROCEDURE PC(mod: ARRAY OF CHAR; name: ARRAY OF CHAR): LONGINT;
END Ref.
Home |
Site_index |
Legal |
OpenVMS_compiler |
Alpha_Oberon_System |
ModulaTor |
Bibliography |
Oberon[-2]_links |
Modula-2_links |
Number of visitors for this page: