Syntax10.Scn.FntInfoElemsAllocSyntax10.Scn.Fnt StampElemsAlloc14 May 97!LinkElemsAllocTypes.ModY=%"Title": Types "Author": Copyright (c) Rgis Crelier, 1992-96 / rc 16.1.92 , RLI "Abstract": Types provides a means of metaprogramming "Keywords": Metaprogramming, Types, Type Descriptors "Version": 1.2 "From": 1992 "Until":  "Changes": RLI NewObj patched  14 May 97 RLI RefposOf integrated (taken from Windows-Version) "Hints": See "Metaprogramming Facilities in Oberon for Windows", a technical report, available at ftp.ssw.uni-linz.ac.at/pub/Reports Syntax10i.Scn.Fnt-Syntax10b.Scn.Fnt 2Y#38FoldElemsNew8 "88 808 8~8 8MarkElemsAllocY=% (8 MODULE Types;  IMPORT Modules, Kernel, S := SYSTEM; TYPE Type* = POINTER TO TypeDesc; TypeDesc* = RECORD tdsize: LONGINT; sentinel: LONGINT; (* -4 *) tag: Kernel.Tag; ext0: RECORD extlev: SHORTINT; filler: ARRAY 3 OF CHAR END ; name*: ARRAY 32 OF CHAR; module*: Modules.Module END ; PROCEDURE This* (mod: Modules.Module; name: ARRAY OF CHAR): Type;  VAR type: Type; i: LONGINT; BEGIN IF name # "" THEN i := LEN(mod.tdescs^); WHILE i > 0 DO DEC(i); type := S.VAL(Type, mod.tdescs[i]); S.GET(S.VAL(LONGINT, type) - 4, type); IF type.name = name THEN RETURN type END END END ; RETURN NIL END This;  PROCEDURE BaseOf* (t: Type; level: INTEGER): Type;  BEGIN S.GET(S.VAL(LONGINT, t.tag) - 8 - 4 * level, t); IF t # NIL THEN S.GET(S.VAL(LONGINT, t) - 4, t) END ; RETURN t END BaseOf;  PROCEDURE LevelOf* (t: Type): INTEGER;  BEGIN RETURN LONG(t.ext0.extlev) END LevelOf;  PROCEDURE RefposOf* (t: Type): LONGINT; BEGIN RETURN ORD(t.ext0.filler[1]) * 256 + ORD(t.ext0.filler[0]) + S.ADR(t.module.refs^) END RefposOf; PROCEDURE TypeOf* (o: S.PTR): Type;  VAR type: Type; BEGIN S.GET(S.VAL(LONGINT, o) - 4, type); S.GET(S.VAL(LONGINT, type) - 4, type); RETURN type END TypeOf;  PROCEDURE NewObj* (VAR o: S.PTR; t: Type);  VAR otype: Type; h: LONGINT; BEGIN S.GET(S.VAL(LONGINT, o) - 4, otype); IF BaseOf(t, LevelOf(otype)) # otype THEN o := NIL; RETURN END ; Kernel.NewRec(t.tag, h); (* Patch, RLI *) o := S.VAL(S.PTR, h) END NewObj;  END Types.