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. Œ VMImpl.mesa Copyright Σ 1988, 1990, 1991 by Xerox Corporation. All rights reserved. Carl Hauser, October 19, 1988 11:38:40 am PDT Spreitze, May 2, 1990 10:31 am PDT Willie-s, July 30, 1991 5:52 pm PDT Chauser, July 23, 1992 5:51 pm PDT Michael Plass, August 31, 1992 11:55 am PDT Size Parameterization the unitsPerPage is needed for address calculations - be careful if unitsPerPage#bytesPerPage Errors Public Procedures This implementation can only free an entire previously allocated interval. MJS May 2, 1990: removed test on result 'cause valloc_free returns void. MFP August 31, 1992: Added monitor; added test on full interval; fixed a bug in updating allocList. should touch every page in the interval, but needn't Access to underlying system routines AlignedAlloc must not allow blocks it allocates to be collected until valloc_free has been called. Utilities works only for n a power of 2 Κl–(cedarcode) style•NewlineDelimiter ™šœ ™ Icodešœ Οeœ=™HK™-K™"K™#K™"K™+J™—šΟk ˜ Kš œžœ!žœž œž œ˜KKšžœžœΛ˜ΣK˜—K˜KšΠlnœžžžžž˜Kšžœ ž˜Kšžœž˜ Kšœžœžœžœ˜head™šœžœžœ˜)Kšœžœžœ˜1—šœžœžœ$˜