z>Syntax10.Scn.FntSyntax10i.Scn.FntMarkElemsAlloc`=IStampElemsAlloc30 Sep 97qInfoElemsAllocVSyntax10.Scn.Fnt+StampElemsAlloc30 Sep 97"Title": Platform "Author": Martin Rammerstorfer (MR) "Abstract": . "Keywords": Heap, module descriptors, System dependent "Version": 1 "From": 28.06.96 15:14:03 "Until":  "Changes": no changes "Hints":MpVersionElemsAllocBeg#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.Fnt<<<== Click here to change version of Platform (now: PowerMac) ;pVersionElemsAllocEnd#p#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.Fnt,Modules p 8FoldElemsNewSyntax10b.Scn.Fntp#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.Fnt16p p#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.Fnt30pp#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.Fnt31p 888  8 8  8 ! 8%88    p#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMacwSyntax10.Scn.FntSyntax10b.Scn.Fnt       ( refcnt*, initialized: INTEGER; key-, datasize-, blocksize-, refsize-: LONGINT; consize-, codesize-, nofentries-, nofcmds-: INTEGER; nofimps-, noftds-, nofptrs-, noftraps-: INTEGER; block-, SB-, PC-, entries-, commands-:LONGINT; imports-, typedescs-, pointers-, traps-, refs-: LONGINT   !!+.p88  8 8   8 88988p#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMacQSyntax10.Scn.Fnt"Syntax10b.Scn.Fnt7jheaps: POINTER TO ARRAY OF RECORD heapBeg*, heapEnd*: LONGINT END; numHeaps: INTEGER; heapSize: LONGINT;6p8Kp#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMacFSyntax10.Scn.Fnt 8FoldElemsNew#Syntax10.Scn.Fnt VAR i, j: LONGINT; BEGIN FOR i := numHeaps - 1 TO Kernel.numHeaps - 1 DO j := 0; WHILE (j < numHeaps) & (heaps [i].heapBeg # Kernel.heap [j].heapBeg) DO INC (j) END; IF j < Kernel.numHeaps THEN heaps [numHeaps].heapBeg := Kernel.heap [j].heapBeg; heaps [numHeaps].heapEnd := Kernel.heap [j].heapEnd; INC (numHeaps) END END; heapSize := 0; FOR i := 0 TO numHeaps - 1 DO INC (heapSize, heaps [i].heapEnd - heaps [i].heapBeg) END END UpdateHeap; 8PROCEDURE UpdateHeap (); p m  81zp#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.FntModules.modules p8 m 8zp#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.FntModules.modules p8 m$8p#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.FntNIL p8 m8~p#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.Fnt mod.nofptrs p8 m 8}p#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.Fnt mod.pointers p8 m %8up#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.FntVAR offset: LONGINT;pMp#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.Fnt<<S.GET (mod.pointers + 4 * i, offset); RETURN offset + mod.SB p8 m8p#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.Fnt mod.noftds p8 m 8|p#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.Fnt mod.typedescs p8 m %8>p#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.FntKKS.GET (mod.typedescs + 4 * i, tadr); S.GET (tadr - 4, tadr); DEC (tadr, 3); 2p 8 m8zp#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.Fntmod.nofimps + 1 p8 m8xp#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.FntVAR val: LONGINT;pfp#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.Fnt##RETURN S.VAL (LONGINT, mod.imports) #p8 m%8xp#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.FntVAR val: LONGINT;p]p#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.Fnt,,S.GET (mod.imports + 4 * i, val); RETURN val p8 m&8p#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.Fnt HALT (99) %p8 m 8(8 m !838 m?8p#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac  ptp#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.FntIF Kernel.numHeaps # numHeaps THEN UpdateHeap () END; IF (iterator >= Kernel.numHeaps) OR (iterator < 0) THEN first := NIL; end := NIL; RETURN FALSE END; first := S.VAL (Blockm4Ptr, Kernel.heap [iterator].heapBeg); end := S.VAL (Blockm4Ptr, Kernel.heap [iterator].heapEnd); p48 m8$Syntax10i.Scn.Fnt(( Checks if address is in an oberon heap zp#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.FntVAR i: INTEGER;pp#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.FntIF Kernel.numHeaps # numHeaps THEN UpdateHeap () END; i := 0; WHILE (i < numHeaps) & ((adr < heaps [i].heapBeg) OR (adr >= heaps [i].heapEnd)) DO INC (i) END; RETURN i < numHeaps Lp8 m8ip#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.Fnt VAR i: INTEGER; relCnt: LONGINT;pWp#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.Fnt22IF Kernel.numHeaps # numHeaps THEN UpdateHeap () END; i := 0; relCnt := 0; WHILE (i < numHeaps) & (adr < heaps [i].heapBeg) & (adr >= heaps [i].heapEnd) DO INC (i); INC (relCnt, heaps [i].heapEnd - heaps [i].heapBeg) END; IF i < numHeaps THEN RETURN relCnt + adr - heaps [i].heapBeg ELSE RETURN 0 END p8 m8zp#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.FntVAR i: INTEGER;p+p#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMacQSyntax10.Scn.FntSyntax10b.Scn.Fnt#0IF Kernel.numHeaps # numHeaps THEN UpdateHeap () END; i := 0; WHILE (i < numHeaps) & (adr > (heaps [i].heapEnd - heaps [i].heapBeg)) DO DEC (adr, heaps [i].heapEnd - heaps [i].heapBeg); INC (i) END; IF i < numHeaps THEN RETURN adr + heaps [i].heapBeg + 4 ELSE RETURN heaps [i - 1].heapEnd + 4 END p8 m;8lp#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.FntKernel.RegisterObject (o, fh) Ap8 m 8Cp#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.FntFFIF Kernel.numHeaps # numHeaps THEN UpdateHeap () END; RETURN heapSize p8 b8$Syntax10i.Scn.Fnt22 Like Types.TypeOf (but also arrays, marked objs) Mp#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.Fnt<<DEC (S.VAL (LONGINT, type), 3); (* is marked as type desc *)p8 m ;8> #p#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.FntIF p.m4 = -4 THEN tdesc := S.VAL (Tag, obj); RETURN TTypDesc (* TypeDesc *) ELSIF S.VAL (LONGINT, tdesc) = S.VAL (LONGINT, obj) THEN tdesc := S.VAL (Tag, obj); RETURN TFree (* Free block *) ELSE S.GET (S.VAL (LONGINT, tdesc) - 4, sTag); IF arrayBit IN S.VAL (SET, sTag) THEN RETURN TObj (* Other object *) ELSE RETURN TSysBl (* SysBlock, Array without pointer *) END END p8 m8vp#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.FntRETURN type.ext [0] [p8 m A8}p#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.Fnt mod.codesize p }p#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.Fnt mod.datasize p ~p#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.Fnt mod.refsize p p#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.Fnt mod.noftds pp#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.Fntcode + data + refs + mod.consize + mod.blocksize + (nOfTD + mod.nofimps + mod.nofptrs + mod.noftraps) * 4 + mod.nofcmds * 26 + mod.nofentries * 2 p8 m 8|p#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.Fnt VAR set: SET;pp#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac<Syntax10i.Scn.FntSyntax10.Scn.Fnt S.GET (S.VAL (LONGINT, mod) - 4, set); set := set + {markBit}; S.PUT (S.VAL (LONGINT, mod) - 4, set); S.GET (mod.block - 8, set); set := set + {markBit}; S.PUT (mod.block - 8, set) p88~p#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.Fnt i: INTEGER; pp#Syntax10.Scn.FntWindows PowerMacWindowsWindows PowerMac#Syntax10.Scn.Fnt  heapSize := 0; NEW (heaps, LEN (Kernel.heap)); numHeaps := Kernel.numHeaps; FOR i := 0 TO numHeaps - 1 DO heaps [i].heapBeg := Kernel.heap [i].heapBeg; heaps [i].heapEnd := Kernel.heap [i].heapEnd; INC (heapSize, heaps [i].heapEnd - heaps [i].heapBeg) END  p  8MODULE Platform; (* Platform by MR 17 Dec 96 -   *) (*<== Click here to change version of Platform (now: Windows)*) IMPORT S := SYSTEM, Kernel, Types , Ref; CONST  B* = 32; arrayBit* = 1; markBit* = 0; TFree* = 1; TObj* = 2; TTypDesc* = 3; TSysBl* = 4; TArrP* = 5;  TYPE  Tag* = POINTER TO TypeDesc;  TypeDesc = RECORD size-: LONGINT; ptrOffs-: LONGINT; (* -4 if no pointers in type *) END ;  Blockm4Ptr* = POINTER TO Blockm4;  Blockm4 = RECORD tag*: Tag; lastElemToMark-: LONGINT; m4-: LONGINT; self: Tag; END;  ADDRESS = LONGINT; AddressList* = POINTER TO ARRAY OF ADDRESS; Name* = ARRAY 32 OF CHAR; TerminationHandler* = PROCEDURE; Cmd* = RECORD  name*: Name; adr*: ADDRESS END; Module* = POINTER TO ModuleDesc;  ModuleDesc* = RECORD next*: Module; name*: Name; init*: BOOLEAN; key*, refcnt*, sb-: LONGINT; varEntries-, entries-: POINTER TO ARRAY OF ADDRESS; cmds-: POINTER TO ARRAY OF Cmd; ptrTab-: POINTER TO ARRAY OF ADDRESS; tdescs-: POINTER TO ARRAY OF (* Tag *) ADDRESS; imports-: POINTER TO ARRAY OF (* Module *) ADDRESS; data-, code-, refs-: POINTER TO ARRAY OF CHAR; term-: TerminationHandler END; TypeS* = POINTER TO TypeSDesc;  TypeSDesc = RECORD tdsize*, m4*: LONGINT; self*: Tag; ext*: ARRAY 4 OF SHORTINT; name*: ARRAY 32 OF CHAR; mdesc*: Module; END; TypeDescS* = POINTER TO TypeDescSDesc;  TypeDescSDesc = RECORD superTag*: Tag; self*: Tag; ext*: ARRAY 4 OF SHORTINT; name*: ARRAY 32 OF CHAR; mdesc*: Module; END; TypeFreeBlk* = POINTER TO TypeFreeBlkDesc;  TypeFreeBlkDesc = RECORD tag*, size*, next*: LONGINT; END; Proc = PROCEDURE; (* different sizes under Windows (4) and PowerMac Oberon (8) *)  VAR  firstBlock, endBlock: LONGINT; (* Addresses must be of type LONGINT, because of GC *)   PROCEDURE GetModules* (): Module;  VAR mod: LONGINT; BEGIN RETURN S.VAL (Module, Kernel.modules) END GetModules;  PROCEDURE SetModules* (modList: Module);  BEGIN S.PUT (S.ADR (Kernel.modules), modList) END SetModules;  PROCEDURE GetTermHandler* (mod: Module): TerminationHandler;  BEGIN RETURN mod.term END GetTermHandler;  PROCEDURE GetNoOfPtrsInMod* (mod: Module): INTEGER;  BEGIN RETURN SHORT (LEN (mod.ptrTab^)) END GetNoOfPtrsInMod;  PROCEDURE GetPtrsInMod* (mod: Module): LONGINT;  BEGIN RETURN S.ADR (mod.ptrTab^) END GetPtrsInMod;  PROCEDURE GetPtrInMod* (mod: Module; i: INTEGER): LONGINT;   BEGIN RETURN mod.ptrTab [i] END GetPtrInMod;  PROCEDURE GetNoOfTDsInMod* (mod: Module): INTEGER;  BEGIN RETURN SHORT (LEN (mod.tdescs^)) END GetNoOfTDsInMod;  PROCEDURE GetTDsInMod* (mod: Module): LONGINT;  BEGIN RETURN S.ADR (mod.tdescs^) END GetTDsInMod;  PROCEDURE GetTDInMod* (mod: Module; i: INTEGER): LONGINT;  VAR tadr: LONGINT; BEGIN S.GET (S.VAL (LONGINT, mod.tdescs [i]) - 4, tadr); RETURN tadr END GetTDInMod;  PROCEDURE GetNoOfImportsInMod* (mod: Module): INTEGER;  BEGIN RETURN SHORT (LEN (mod.imports^)) END GetNoOfImportsInMod;  PROCEDURE GetImportsInMod* (mod: Module): LONGINT;   BEGIN RETURN S.VAL (LONGINT, mod.imports) END GetImportsInMod;  PROCEDURE GetImportInMod* (mod: Module; i: LONGINT): LONGINT;   BEGIN RETURN mod.imports [i] END GetImportInMod;  PROCEDURE SetPtrToImportList* (mod: Module; imports: AddressList);  BEGIN S.PUT (S.ADR (mod.imports), S.VAL (S.PTR, imports)) END SetPtrToImportList;  PROCEDURE GetRefcnt* (mod: Module): LONGINT;  BEGIN RETURN mod.refcnt END GetRefcnt;  PROCEDURE SetRefcnt* (mod: Module; refcnt: LONGINT);  BEGIN mod.refcnt := SHORT (refcnt) END SetRefcnt;  PROCEDURE GetNextMemBlock* (VAR first, end: Blockm4Ptr; VAR iterator: INTEGER): BOOLEAN;  VAR ok: BOOLEAN; BEGIN IF iterator # 0 THEN first := NIL; end := NIL; RETURN FALSE END; (* Windows Oberon => one heap *) first := S.VAL (Blockm4Ptr, firstBlock); end := S.VAL (Blockm4Ptr, endBlock); INC (iterator); RETURN TRUE END GetNextMemBlock;  PROCEDURE AddressInHeap* (adr: LONGINT): BOOLEAN;   BEGIN RETURN (adr >= Kernel.heapAdr) & (adr <= (Kernel.heapAdr + Kernel.heapSize)) END AddressInHeap;  PROCEDURE AddressAbsToRel* (adr: LONGINT): LONGINT;   BEGIN RETURN adr - Kernel.heapAdr END AddressAbsToRel;  PROCEDURE AddressRelToAbs* (adr: LONGINT): LONGINT;   BEGIN RETURN adr + Kernel.heapAdr END AddressRelToAbs;  PROCEDURE InstallTermHandler* (th: TerminationHandler; fh: Kernel.Finalizer; o: S.PTR);  BEGIN Kernel.InstallTermHandler (S.VAL (Kernel.TerminationHandler, th)) END InstallTermHandler;  PROCEDURE GetHeapSize* (): LONGINT;  BEGIN RETURN Kernel.heapSize END GetHeapSize;  PROCEDURE TypeOf* (o: S.PTR): Types.Type;  VAR type: Types.Type; BEGIN S.GET(S.VAL (LONGINT, S.VAL (SET, S.VAL(LONGINT, o) - 4) - {arrayBit, markBit}), type); S.GET(S.VAL (LONGINT, S.VAL (SET, S.VAL(LONGINT, type) - 4) - {arrayBit, markBit}), type);  RETURN type END TypeOf;  PROCEDURE GetObjType* (obj: S.PTR; VAR tdesc: Tag; VAR size: LONGINT): INTEGER;  VAR p: Blockm4Ptr; notmarked: Tag; sTag: LONGINT; BEGIN p := S.VAL (Blockm4Ptr, S.VAL (LONGINT, obj) - 4); notmarked := S.VAL (Tag, S.VAL (SET, p.tag) - {markBit}); tdesc := S.VAL (Tag, S.VAL (SET, notmarked) - {arrayBit}); IF notmarked # tdesc THEN size := p.lastElemToMark + tdesc.size - S.VAL(LONGINT, p); RETURN TArrP (* Array with pointer *) ELSE size := tdesc.size + 4; IF notmarked = S.VAL (Tag, obj) THEN (* Free block, TypeDesc, SysBlock, Array without pointer *) IF p.m4 = -4 THEN (* TypeDesc, SysBlock, Array without pointer *) sTag := S.VAL (LONGINT, p.self) - 4; IF AddressInHeap (sTag) THEN S.GET (sTag, sTag) END; IF (sTag - 4) # S.VAL (LONGINT, p) THEN RETURN TSysBl (* SysBlock, Array without pointer *) ELSE tdesc := S.VAL (Tag, obj); RETURN TTypDesc (* TypeDesc *) END ELSE RETURN TFree (* Free block *) END ELSE RETURN TObj (* Other object *) END END END GetObjType;  PROCEDURE GetNoOfMethods* (type: TypeS): INTEGER;  BEGIN RETURN SHORT (S.VAL (LONGINT, type.self) - S.VAL (LONGINT, type) - 48 - 72) DIV SIZE (Proc) END GetNoOfMethods;  PROCEDURE GetSizes* (mod: Module; VAR code, data, refs, sizeOfAll, nOfTD: LONGINT);  BEGIN code := LEN (mod.code^); data := LEN (mod.data^); refs := LEN (mod.refs^); nOfTD := LEN (mod.tdescs^); sizeOfAll := SIZE (ModuleDesc) + (LEN (mod.varEntries^) + LEN (mod.entries^) +LEN (mod.cmds^) + LEN (mod.ptrTab^) + nOfTD + LEN (mod.imports^)) * 4 + code + data + refs END GetSizes;  PROCEDURE SetModMarks* (mod: Module);   BEGIN  (* ... For use in mark-phase (GC). In Windows Oberon not necessary => ModuleDesc and ModuleBlock are marked via Kernel.Modules *) END SetModMarks;  PROCEDURE Init ();  VAR r: Ref.Rider; BEGIN Ref.OpenVars ("Kernel", r); WHILE (r.mode # Ref.End) & (r.name # "firstBlock") DO r.Next END ; r.ReadLInt (firstBlock); Ref.OpenVars ("Kernel", r); WHILE (r.mode # Ref.End) & (r.name # "endBlock") DO r.Next END; r.ReadLInt (endBlock) END Init;  BEGIN Init END Platform.