ð#Syntax10.Scn.Fnt^^MODULE Types; (* RC 16.1.92 *) 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 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 ; o := S.VAL(S.PTR, Kernel.NewRec(t.tag)) END NewObj; END Types.