home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / system / types.mod (.txt) < prev    next >
Oberon Text  |  1977-12-31  |  2KB  |  65 lines
  1. Syntax10.Scn.Fnt
  2. ParcElems
  3. Alloc
  4. Syntax24b.Scn.Fnt
  5. (* AMIGA *)
  6. MODULE Types;    (* RC 16.1.92  -  AMIGA-Version 20.4.95 Ralf Degner *)
  7. IMPORT Modules, Kernel, S := SYSTEM;
  8.     Type* = POINTER TO TypeDesc;
  9.     TypeDesc* = RECORD
  10.         size*: LONGINT;
  11.         extensionLevel: INTEGER;
  12.         methodCnt: INTEGER;
  13.         module*: Modules.Module;
  14.         reserved: LONGINT;
  15.         name*: Modules.ModuleName;
  16.         baseTypes: ARRAY 8 OF LONGINT;
  17.             pointerOffsets:ARRAY OF LONGINT;
  18.     END;
  19.     Entry = POINTER TO EntryDesc;    
  20.     EntryDesc = RECORD l:LONGINT; END;
  21.     PROCEDURE This*(mod: Modules.Module; name: ARRAY OF CHAR): Type;
  22.         VAR
  23.             type: Type;
  24.             i: LONGINT;
  25.             entry: Entry;
  26.     BEGIN
  27.         IF name # "" THEN
  28.             FOR i:=0 TO mod.nofentries-1 DO
  29.                 entry:=S.VAL(Entry, mod.entries+4*i);
  30.                 IF entry.l<(-mod.dataSize) THEN
  31.                     type:=S.VAL(Type, mod.code+entry.l);
  32.                     IF type.name = name THEN RETURN type END;
  33.                 END;
  34.             END;
  35.         END ;
  36.         RETURN NIL
  37.     END This;
  38.     PROCEDURE BaseOf*(t: Type; level: INTEGER): Type;
  39.     BEGIN
  40.         IF (level<=t.extensionLevel) & (level>=0) THEN
  41.             RETURN S.VAL(Type, t.baseTypes[level]);
  42.         ELSE
  43.             RETURN NIL
  44.         END;
  45.     END BaseOf;
  46.     PROCEDURE LevelOf*(t: Type): INTEGER;
  47.     BEGIN
  48.         RETURN t.extensionLevel
  49.     END LevelOf;
  50.     PROCEDURE TypeOf*(o: S.PTR): Type;
  51.         VAR type: Type;
  52.     BEGIN
  53.         S.GET(S.VAL(LONGINT, o)-4, type);
  54.         RETURN type
  55.     END TypeOf;
  56.     PROCEDURE NewObj*(VAR o: S.PTR; t: Type);
  57.         VAR
  58.             otype: Type;
  59.     BEGIN
  60.         otype:=S.VAL(Type, o);
  61.         IF BaseOf(t, LevelOf(otype)) # otype THEN o := NIL; RETURN END;
  62.         o := S.VAL(S.PTR, Kernel.New(S.VAL(LONGINT, t)));
  63.     END NewObj;
  64. END Types.
  65.