-- File: Segs.mesa
-- Edited by: Sandman, July 10, 1980  7:55 AM
-- Copyright  Xerox Corporation 1979, 1980

DIRECTORY
  AltoDefs USING [PageSize],
  InlineDefs USING [BITAND, DIVMOD],
  Mopcodes USING [zLI4, zRFS, zSHIFT, zWFS],
  SegmentDefs USING [
    FileHandle, GetEndOfFile, GetFileAccess, PageCount, PageNumber],
  SegOps USING [DefaultBase, DefaultFile, DefaultPages, Seg, SegObject],
  Storage USING [Pages, FreePages],
  WartDefs USING [NullSeg];

Segs: PROGRAM
  IMPORTS InlineDefs, SegmentDefs, Storage EXPORTS SegOps SHARES SegOps =
  BEGIN OPEN AltoDefs, SegmentDefs, WartDefs, SegOps;
  
  vmFile: PUBLIC FileHandle _ NIL;
  
  TooManySegs: PUBLIC SIGNAL = CODE;
  
  VMBusy: PUBLIC SIGNAL [base: PageNumber, pages: PageCount] = CODE;
  InvalidSegSize: PUBLIC ERROR = CODE;
  NoVM: PUBLIC SIGNAL [needed: PageCount] = CODE;
  
  NewSeg: PUBLIC PROCEDURE [
    file: FileHandle, base: PageNumber, pages: PageCount, write: BOOLEAN _ FALSE]
    RETURNS [s: Seg] =
    BEGIN
    IF file = DefaultFile THEN file _ vmFile;
    s _ GetSeg[];
    BEGIN
    ENABLE UNWIND => ReturnSeg[s];
    IF file = vmFile THEN
      BEGIN
      IF pages = DefaultPages OR pages <= 0 THEN ERROR InvalidSegSize;
      IF base = DefaultBase THEN base _ AllocVM[pages, -1]
      ELSE
	IF base IN [0..256) THEN
	  BEGIN
	  WHILE ~PagesFree[base, pages] DO SIGNAL VMBusy[base, pages]; ENDLOOP;
	  ReserveVM[base, pages]
	  END
      END
    ELSE
      BEGIN
      [] _ GetFileAccess[file];
      IF base = DefaultBase THEN base _ 1;
      IF pages = DefaultPages THEN pages _ GetEndOfFile[file].page - base + 1;
      END;
    END;
    s^ _ SegObject[
      realFile: file, resident: TRUE, write: write, data: TRUE, in: FALSE,
      inUse: TRUE, base: base, pages: pages, vmPage: 0, lockCount: 0,
      trueFile: NIL, imageBase: 0, link: NIL, link2: NIL,
      index: WartDefs.NullSeg];
    IF file # vmFile THEN file.segcount _ file.segcount + 1
    ELSE BEGIN s.in _ TRUE; s.vmPage _ base; s.lockCount _ 1; END;
    RETURN
    END;
    
  -- Swapping Segments (but faking it)
  
  SwappingError: PUBLIC ERROR [s: Seg] = CODE;
  
  SwapInSeg: PUBLIC PROCEDURE [s: Seg] =
    BEGIN
    ValidateSeg[s];
    IF ~s.in THEN
      BEGIN
      IF s.pages = 0 THEN ERROR SwappingError[s];
      s.vmPage _ AllocVM[s.pages, 1];
      s.in _ TRUE;
      END;
    s.lockCount _ s.lockCount + 1;
    RETURN
    END;
    
  UnlockSeg: PUBLIC PROCEDURE [s: Seg] =
    BEGIN
    ValidateSeg[s];
    IF s.lockCount = 0 THEN ERROR SwappingError[s];
    s.lockCount _ s.lockCount - 1;
    RETURN
    END;
    
  SwapOutSeg: PUBLIC PROCEDURE [s: Seg] =
    BEGIN OPEN InlineDefs;
    ValidateSeg[s];
    IF ~s.in THEN RETURN;
    IF s.pages = 0 OR s.lockCount > 0 THEN ERROR SwappingError[s];
    ReleaseVM[s.vmPage, s.pages];
    s.in _ FALSE;
    s.vmPage _ 0;
    RETURN
    END;
    
  -- VM Suboutines
  
  PageState: TYPE = {free, busy};
  PageID: TYPE = WORD;
  PageMapHandle: TYPE = POINTER TO PageMap;
  PageMap: TYPE = ARRAY [0..15] OF WORD;
  
  VMmap: PageMap _ ALL[0];
  
  MakePageID: PROCEDURE [PageNumber] RETURNS [PageID] = MACHINE CODE
    BEGIN Mopcodes.zLI4; Mopcodes.zSHIFT END;
    
  GetPageState: PROCEDURE [page: PageNumber] RETURNS [PageState] =
    BEGIN OPEN InlineDefs;
    
    ReadPageState: PROCEDURE [PageMapHandle, PageID] RETURNS [PageState] = MACHINE
      CODE BEGIN Mopcodes.zRFS END;
      
    RETURN[ReadPageState[@VMmap, MakePageID[page]]];
    END;
    
  SetPageState: PROCEDURE [page: PageNumber, state: PageState] =
    BEGIN OPEN InlineDefs;
    
    WritePageState: PROCEDURE [PageState, PageMapHandle, PageID] = MACHINE CODE
      BEGIN Mopcodes.zWFS END;
      
    WritePageState[state, @VMmap, MakePageID[page]];
    RETURN;
    END;
    
  ffvmp, lfvmp: PUBLIC CARDINAL;
  minap, maxap: PageNumber;
  
  AllocVM: PROCEDURE [pages: PageCount, direction: INTEGER] RETURNS [PageNumber] =
    BEGIN
    n: INTEGER;
    pg, end, base: PageNumber;
    IF pages~ IN (0..256] THEN ERROR InvalidSegSize;
    DO 
      -- repeat if insufficient VM
      IF direction > 0 THEN
	BEGIN
	direction _ 1;
	-- eliminate any prefix of allocated pages and update ffvmp
	FOR ffvmp IN [ffvmp..lfvmp] DO
	  IF GetPageState[ffvmp] = free THEN EXIT; ENDLOOP;
	pg _ ffvmp;
	end _ lfvmp;
	END
      ELSE
	BEGIN
	direction _ -1;
	-- eliminate any suffix of allocated pages and update lfvmp
	FOR lfvmp DECREASING IN [ffvmp..lfvmp] DO
	  IF GetPageState[lfvmp] = free THEN EXIT; ENDLOOP;
	pg _ lfvmp;
	end _ ffvmp;
	END;
      n _ 0; -- count of contiguous free pages
      FOR pg _ pg, pg + direction UNTIL
	(IF direction > 0 THEN pg > end ELSE pg < end) DO
	IF GetPageState[pg] # free THEN n _ 0 -- page in use; reset free count
	  
	ELSE
	  IF (n _ n + 1) = pages THEN
	    BEGIN
	    base _ IF direction > 0 THEN pg - n + 1 ELSE pg;
	    ReserveVM[base, pages];
	    RETURN[base]
	    END;
	ENDLOOP;
      SIGNAL NoVM[pages];
      ENDLOOP
    END;
    
  ReleaseVM: PROCEDURE [base: CARDINAL, pages: CARDINAL] =
    BEGIN
    ffvmp _ MIN[ffvmp, base];
    lfvmp _ MAX[lfvmp, base + pages - 1];
    FOR base IN [base..base + pages) DO SetPageState[base, free]; ENDLOOP;
    RETURN
    END;
    
  ReserveVM: PROCEDURE [base: CARDINAL, pages: CARDINAL] =
    BEGIN
    IF ffvmp IN [base..base + pages) THEN ffvmp _ base + pages;
    IF lfvmp IN [base..base + pages) THEN lfvmp _ base - 1;
    FOR base IN [base..base + pages) DO SetPageState[base, busy]; ENDLOOP;
    RETURN
    END;
    
  SetVMBounds: PROCEDURE [fp, lp: PageNumber] =
    BEGIN minap _ ffvmp _ fp; maxap _ lfvmp _ lp; RETURN END;
    
  PagesFree: PROCEDURE [base: PageNumber, pages: PageCount] RETURNS [BOOLEAN] =
    BEGIN
    FOR base IN [base..base + pages) DO
      IF GetPageState[base] # free THEN RETURN[FALSE]; ENDLOOP;
    RETURN[TRUE]
    END;
    
  -- Segment Sub-Routines
  
  freeSegs: Seg _ NIL;
  tables: SegTableHandle _ NIL;
  
  SegsPerTable: CARDINAL = (AltoDefs.PageSize - 1)/SIZE[SegObject];
  
  SegTable: TYPE = RECORD [
    link: SegTableHandle, segs: ARRAY [0..SegsPerTable) OF SegObject];
  
  SegTableHandle: TYPE = POINTER TO SegTable;
  
  InvalidSeg: PUBLIC ERROR [POINTER] = CODE;
  
  ValidateSeg: PUBLIC PROCEDURE [s: Seg] =
    BEGIN OPEN InlineDefs;
    table: SegTableHandle _ BITAND[s, 177400B];
    i, j: CARDINAL;
    t: SegTableHandle;
    FOR t _ tables, t.link UNTIL t = NIL DO
      IF t = table THEN EXIT; REPEAT FINISHED => ERROR InvalidSeg[s]; ENDLOOP;
    [i, j] _ DIVMOD[s - @table.segs[0], SIZE[SegObject]];
    IF j # 0 OR ~s.inUse THEN ERROR InvalidSeg[s];
    RETURN
    END;
    
  InitSegMachinery: PUBLIC PROCEDURE [firstpage, lastpage: PageNumber] =
    BEGIN
    t: SegTableHandle;
    SetVMBounds[firstpage, lastpage];
    FOR t _ tables, tables UNTIL t = NIL DO
      tables _ t.link; Storage.FreePages[t]; ENDLOOP;
    freeSegs _ NIL;
    RETURN
    END;
    
  GetNewTable: PROCEDURE =
    BEGIN
    t: SegTableHandle _ Storage.Pages[1];
    tt: SegTableHandle;
    i: CARDINAL;
    t.link _ NIL;
    FOR i DECREASING IN [0..SegsPerTable) DO ReturnSeg[@t.segs[i]]; ENDLOOP;
    IF tables = NIL THEN BEGIN tables _ t; RETURN END;
    FOR tt _ tables, tt.link UNTIL tt.link = NIL DO NULL ENDLOOP;
    tt.link _ t;
    RETURN
    END;
    
  GetSeg: PROCEDURE RETURNS [s: Seg] =
    BEGIN
    IF freeSegs = NIL THEN GetNewTable[];
    s _ freeSegs;
    freeSegs _ s.link;
    s.inUse _ TRUE;
    RETURN
    END;
    
  ReturnSeg: PROCEDURE [s: Seg] =
    BEGIN s.inUse _ FALSE; s.link _ freeSegs; freeSegs _ s; RETURN END;
    
  EnumerateSegs: PUBLIC PROCEDURE [proc: PROCEDURE [Seg] RETURNS [BOOLEAN]]
    RETURNS [seg: Seg] =
    BEGIN
    i: CARDINAL;
    t: SegTableHandle;
    FOR t _ tables, t.link UNTIL t = NIL DO
      FOR i IN [0..SegsPerTable) DO
	seg _ @t.segs[i]; IF seg.inUse AND proc[seg] THEN RETURN[seg]; ENDLOOP;
      ENDLOOP;
    RETURN[NIL]
    END;
    
  
  END...