ðÈSyntax10.Scn.Fnt}Syntax10b.Scn.FntÝ8´P‰˜HêMODULE Types; (* RC 16.1.92 / MH 30.8.93 adapted to Oberon for Windows *) 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; BEGIN S.GET(S.VAL(LONGINT, o) - 4, otype); IF BaseOf(t, LevelOf(otype)) # otype THEN o := NIL; RETURN END ; Kernel.NewRec(t.tag, S.VAL(LONGINT, o)) END NewObj; END Types.