<> <> <> <> DIRECTORY Environment USING [bitsPerWord, wordsPerPage], BcdOps USING [SPHandle], Heap USING [Create, Delete], Inline USING [LongCOPY, LongDiv, LongMult, LowHalf], MB USING [BitArray, Error, Handle, Zero], MBStorage USING [FreeWords, Words], MBVM USING [ Base, Code, CodeSeg, DataSeg, DefaultBase, Direction, FileSeg, First64K, HyperSpace, MaxBase, MDS, nullIndex, Object, ObjectSeal, Pages, Seg], Segments USING [DeleteSegment, FHandle, LockFromSegment, Unlock], StartList USING [NullSwapUnitIndex]; MBVMemory: PROGRAM IMPORTS Heap, Inline, MB, MBStorage, Segments EXPORTS MB, MBVM = BEGIN OPEN MBVM; PageSize: CARDINAL = Environment.wordsPerPage; data: MB.Handle _ NIL; z: UNCOUNTED ZONE _ NIL; minimumLength: Base = PageSize*Environment.bitsPerWord; incrementalLength: CARDINAL = PageSize*Environment.bitsPerWord; InitVM: PUBLIC PROC [h: MB.Handle] = { IF data ~= NIL THEN FinishVM[]; data _ h; data.lastVMPage _ 0; segList _ NIL; z _ Heap.Create[4]; }; FinishVM: PUBLIC PROC = { IF data.vmMap ~= NIL THEN {MBStorage.FreeWords[BASE[data.vmMap]]; data.vmMap _ NIL}; IF z ~= NIL THEN {Heap.Delete[z]; z _ NIL}; data _ NIL; }; WordsForBits: PROC [nBits: CARDINAL] RETURNS [nWords: CARDINAL] = INLINE {RETURN[(nBits+Environment.bitsPerWord-1)/Environment.bitsPerWord]}; <> segList: Seg _ NIL; AllocMDSData: PUBLIC PROC [ base: Base, pages: Pages, dir: Direction _ down] RETURNS [s: DataSeg] = { SELECT base FROM MDS, DefaultBase => NULL; First64K, HyperSpace, Code => ERROR; ENDCASE => base _ (data.mdsBase + base); RETURN[AllocData[base: base, pages: pages, dir: dir]] }; AllocData: PUBLIC PROC [base: Base, pages: Pages, dir: Direction _ down] RETURNS [s: DataSeg] = { low, high: Base; SELECT base FROM MDS => {low _ data.mdsBase; high _ data.mdsBase+255; base _ DefaultBase}; First64K => {low _ 0; high _ 255; base _ DefaultBase}; HyperSpace => {low _ data.mdsBase+256; high _ MaxBase; base _ DefaultBase}; ENDCASE => {low _ 0; high _ MaxBase}; base _ AllocVM[base: base, pages: pages, dir: dir, high: high, low: low, code: FALSE]; s _ z.NEW[data Object _ Object[ index: StartList.NullSwapUnitIndex, base: base, pages: pages, link: segList, body: data[]] ]; segList _ s; }; AllocCode: PUBLIC PROC [ file: Segments.FHandle, base: Base, pages: Pages, fileBase: CARDINAL, sph: BcdOps.SPHandle] RETURNS [s: CodeSeg] = { low, high: Base; SELECT base FROM Code => {low _ data.codeBase; high _ MaxBase; base _ DefaultBase}; ENDCASE => {low _ 0; high _ MaxBase}; base _ AllocVM[base: base, pages: pages, dir: up, high: high, low: low, code: TRUE]; s _ z.NEW[code Object _ Object[ index: StartList.NullSwapUnitIndex, base: base, pages: pages, link: segList, body: code[sph: sph, file: file, fileBase: fileBase, segment: NIL]]]; segList _ s}; AllocFile: PUBLIC PROC [ file: Segments.FHandle, base: Base, pages: Pages, fileBase: CARDINAL] RETURNS [s: FileSeg] = { low, high: Base; SELECT base FROM MDS => {low _ data.mdsBase; high _ data.mdsBase+255; base _ DefaultBase}; First64K => {low _ 0; high _ 255; base _ DefaultBase}; HyperSpace => {low _ data.mdsBase+256; high _ MaxBase; base _ DefaultBase}; ENDCASE => {low _ 0; high _ MaxBase}; base _ AllocVM[base: base, pages: pages, dir: up, high: high, low: low, code: FALSE]; s _ z.NEW[file Object _ Object[ index: StartList.NullSwapUnitIndex, base: base, pages: pages, link: segList, body: file[file: file, fileBase: fileBase, segment: NIL, bIndex: nullIndex]] ]; segList _ s; }; SortSegs: PUBLIC PROC RETURNS [segs: LONG DESCRIPTOR FOR ARRAY OF MBVM.Seg] = { i, nSegs: CARDINAL; seg: MBVM.Seg; SiftUp: PROC [low, high: CARDINAL] = { k, son: CARDINAL; k _ low; DO IF k*2 > high THEN EXIT; IF k*2+1 > high OR segs[k*2+1-1].base < segs[k*2-1].base THEN son _ k*2 ELSE son _ k*2+1; IF segs[son-1].base < segs[k-1].base THEN EXIT; Exchange[son-1, k-1]; k _ son; ENDLOOP; }; Exchange: PROC [a, b: CARDINAL] = { temp: MBVM.Seg _ segs[a]; segs[a] _ segs[b]; segs[b] _ temp; }; nSegs _ 0; FOR seg _ segList, seg.link UNTIL seg = NIL DO nSegs _ nSegs + 1 ENDLOOP; segs _ DESCRIPTOR[MBStorage.Words[nSegs*SIZE[MBVM.Seg]], nSegs]; i _ 0; FOR seg _ segList, seg.link UNTIL seg = NIL DO segs[i] _ seg; i _ i + 1; ENDLOOP; FOR i DECREASING IN [1..nSegs/2] DO SiftUp[i, nSegs] ENDLOOP; FOR i DECREASING IN [1..nSegs) DO Exchange[0, i]; SiftUp[1, i] ENDLOOP; }; ReleaseCodeSegs: PUBLIC PROC = { FreeOneCodeSegment: PROC [s: Seg] RETURNS [stop: BOOL] = { WITH s SELECT FROM code => IF segment # NIL THEN { IF Segments.LockFromSegment[segment] # 0 THEN Segments.Unlock[segment]; Segments.DeleteSegment[segment]; segment _ NIL; }; ENDCASE; RETURN[FALSE] }; [] _ EnumerateSegs[FreeOneCodeSegment] }; PointerFromSeg: PUBLIC PROC [s: Seg] RETURNS [p: POINTER] = { IF ~(s.base IN [data.mdsBase..data.mdsBase+255]) THEN ERROR; RETURN[LOOPHOLE[(s.base-data.mdsBase)*PageSize]] }; LongPointerFromSeg: PUBLIC PROC [s: Seg] RETURNS [p: LONG POINTER] = { RETURN[LOOPHOLE[Inline.LongMult[s.base, PageSize]]]}; SegFromPointer: PUBLIC PROC [p: POINTER] RETURNS [s: Seg] = { base: Base _ LOOPHOLE[p, CARDINAL]/PageSize; FindSeg: PROC [seg: Seg] RETURNS [BOOL] = {RETURN[s.base = base]}; RETURN[EnumerateSegs[FindSeg]] }; SegFromLongPointer: PUBLIC PROC [p: LONG POINTER] RETURNS [s: Seg] = { base: Base _ Inline.LongDiv[LOOPHOLE[p], PageSize]; FindSeg: PROC [seg: Seg] RETURNS [BOOL] = {RETURN[s.base = base]}; RETURN[EnumerateSegs[FindSeg]] }; <> EnumerateSegs: PROC [proc: PROC [Seg] RETURNS [BOOL]] RETURNS [Seg] = { FOR seg: Seg _ segList, seg.link UNTIL seg = NIL DO IF proc[seg] THEN RETURN[seg]; ENDLOOP; RETURN[NIL] }; AllocVM: PROC [base: Base, pages: Pages, dir: Direction, low, high: Base, code: BOOL] RETURNS [Base] = { vm: Base; IF data.vmMap = NIL THEN { initialLength: CARDINAL = MAX[data.mdsBase, minimumLength]; wordsForMap: CARDINAL = WordsForBits[initialLength]; data.vmMap _ DESCRIPTOR[MBStorage.Words[wordsForMap], initialLength]; MB.Zero[BASE[data.vmMap], wordsForMap]; }; IF base = DefaultBase THEN <> DO incr: INTEGER; n: CARDINAL _ 0; -- count of contiguous free pages SELECT dir FROM up => {incr _ 1; vm _ MIN[low, LENGTH[data.vmMap]-1]}; ENDCASE => {incr _ -1; vm _ MIN[high, LENGTH[data.vmMap]-1]}; FOR vm _ vm, vm+incr UNTIL (IF dir = up THEN vm > high ELSE vm < low) DO IF data.vmMap[vm] OR vm = 0 OR vm = data.mdsBase THEN n _ 0 ELSE IF (n _ n + 1) = pages THEN { base _ IF dir = up THEN vm - n + 1 ELSE vm; IF code AND Spans64KBoundary[base, pages] THEN -- try again on next 64K boundary IF dir = up THEN {n _ 1; vm _ 256*((base+255)/256)} ELSE {n _ 1; vm _ 256*((base+255)/256)-1} ELSE {ReserveVM[base, pages]; RETURN[base]}; n _ 0; }; ENDLOOP; <> <> IF ~ExtendVM[] THEN MB.Error["Memory Full"L]; ENDLOOP ELSE { EnsureAdequateVM[base+pages]; FOR vm IN [base..base+pages) DO IF data.vmMap[vm] OR vm = 0 OR vm = data.mdsBase THEN EXIT; REPEAT FINISHED => {ReserveVM[base, pages]; RETURN[base]}; ENDLOOP; MB.Error["Memory Busy"L]; }; ERROR }; Spans64KBoundary: PROC [base: Base, pages: Pages] RETURNS [BOOL] = { RETURN[(base+pages-1)/256 # base/256]}; ReserveVM: PROC [base: Base, pages: Pages] = { data.lastVMPage _ MAX[base+pages-1, data.lastVMPage]; EnsureAdequateVM[base+pages]; FOR base IN [base..base+pages) DO data.vmMap[base] _ TRUE ENDLOOP; }; EnsureAdequateVM: PROC [size: CARDINAL] = { WHILE size > LENGTH[data.vmMap] DO IF ~ExtendVM[] THEN ERROR; ENDLOOP; }; ExtendVM: PROC RETURNS [worked: BOOL] = { <> newLength: CARDINAL = Inline.LowHalf[MIN[LONG[LENGTH[data.vmMap]] + incrementalLength, LONG[MaxBase] + 1]]; newWords: CARDINAL = WordsForBits[newLength]; newMap: MB.BitArray; IF LENGTH[data.vmMap] = newLength THEN RETURN[FALSE]; newMap _ DESCRIPTOR[MBStorage.Words[newWords], newLength]; MB.Zero[BASE[newMap], newWords]; Inline.LongCOPY[ from: BASE[data.vmMap], to: BASE[newMap], nwords: WordsForBits[LENGTH[data.vmMap]]]; MBStorage.FreeWords[BASE[data.vmMap]]; data.vmMap _ newMap; RETURN[TRUE] }; <> <> ReleaseVM: PROC [base: Base, pages: Pages] = { IF data.lastVMPage = base+pages-1 THEN FOR lastPage: MBVM.Base DECREASING IN [0..data.lastVMPage) DO IF data.vmMap[lastPage] THEN {data.lastVMPage _ lastPage; EXIT}; ENDLOOP; FOR base IN [base..base+pages) DO data.vmMap[base] _ FALSE ENDLOOP }; END.