[ModulaWare, 2.5KB]

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: Counter

Books Music Video Enter keywords...


Amazon.com logo
Webdesign by www.otolo.com/webworx, 09-Feb-1999. © (1998-1999) ModulaWare.com