<<>> <> <> <> <> <> <> <> <<>> DIRECTORY Basics USING [bytesPerWord, logBytesPerWord, BITAND, BITLSHIFT, BITRSHIFT], VM USING [BytesForPages, FalseBool, Interval, logBytesPerPage, LogPageCount, logUnitsPerPage, NullInterval, nullInterval, PageCount, PageNumber, PageNumberForAddress, VMPartition, ZeroPageCount, ZeroPageNumber]; VMImpl: CEDAR MONITOR IMPORTS Basics, VM EXPORTS VM ~ BEGIN OPEN VM; <> bytesPerPage: PUBLIC NAT = GetPageSize[]; logBytesPerPage: PUBLIC NAT = Log2[bytesPerPage]; wordsPerPage: PUBLIC NAT = bytesPerPage/Basics.bytesPerWord; logWordsPerPage: PUBLIC NAT = logBytesPerPage - Basics.logBytesPerWord; <<>> <> unitsPerPage: PUBLIC NAT = bytesPerPage; logUnitsPerPage: PUBLIC NAT = Log2[unitsPerPage]; <> AddressFault: PUBLIC ERROR [address: POINTER] ~ CODE; WriteProtectFault: PUBLIC ERROR [address: POINTER] ~ CODE; CantAllocate: PUBLIC ERROR [bestInterval: Interval] ~ CODE; <> AllocatedInterval: TYPE ~ RECORD [ address: POINTER, -- Prevents collection of VM chunk. interval: Interval ]; allocList: LIST OF AllocatedInterval ¬ NIL; Allocate: PUBLIC PROC [count: PageCount, partition: VMPartition ¬ normalVM, subRange: NullInterval ¬ [0, 0], start: ZeroPageNumber ¬ 0, alignment: LogPageCount ¬ 0, in64K: FalseBool ¬ FALSE] RETURNS [interval: Interval] ~ { byteCount: WORD ¬ LOOPHOLE[BytesForPages[count+1]]; align: WORD ¬ Power2[alignment+logWordsPerPage]; addr: POINTER ¬ NIL; addr ¬ AlignedAlloc[--align,-- byteCount]; IF addr = NIL THEN ERROR CantAllocate[nullInterval]; interval.page ¬ PageNumberForAddress[LOOPHOLE[LOOPHOLE[addr, CARD]+(unitsPerPage-1)]]; interval.count ¬ count; NoteInterval[addr, interval]; }; SimpleAllocate: PUBLIC PROC [count: PageCount] RETURNS [interval: Interval] ~ { interval ¬ Allocate[count]; }; NoteInterval: ENTRY PROC [addr: POINTER, interval: Interval] ~ { allocList ¬ CONS[[addr, interval], allocList]; }; Free: PUBLIC ENTRY UNSAFE PROC [interval: Interval] ~ { <> <> <> lag: LIST OF AllocatedInterval _ NIL; FOR l: LIST OF AllocatedInterval _ allocList, l.rest WHILE l#NIL DO IF l.first.interval = interval THEN { FreePreviouslyAllocatedBlock[l.first.address]; l.first.address ¬ NIL; IF lag = NIL THEN allocList ¬ l.rest ELSE lag.rest ¬ l.rest; RETURN }; lag ¬ l; ENDLOOP; }; Touch: PUBLIC PROC [interval: Interval] ~ { <> }; <> GetPageSize: PROC [] RETURNS [INT] ~ TRUSTED MACHINE CODE { "XR_GetPageSize" }; AlignedAlloc: PROC [size: WORD] RETURNS [p: POINTER] ~ TRUSTED MACHINE CODE { <> "GC_malloc_atomic" }; FreePreviouslyAllocatedBlock: PROC [ptr: POINTER] ~ TRUSTED MACHINE CODE { "GC_free" }; <> Log2: PROC [n: NAT] RETURNS [l: NAT ¬ 0] ~ { <> w: WORD ¬ n; WHILE Basics.BITAND[w, 1] = 0 DO l ¬ l+1; w ¬ Basics.BITRSHIFT[w, 1]; ENDLOOP; }; Power2: PROC [l: NAT] RETURNS [n: NAT] ~ INLINE { RETURN [ Basics.BITLSHIFT[1, l] ]; }; END.