-- Swapper.Mesa  Edited by Sandman on July 30, 1980  11:43 AM
-- Copyright  Xerox Corporation 1979, 1980

DIRECTORY
  AllocDefs USING [SwappingProcedure],
  AltoDefs USING [BYTE, MaxMDSPage, MaxVMPage, PageCount, PageNumber, PageSize],
  AltoFileDefs USING [eofDA, vDC],
  FrameDefs USING [],
  ControlDefs USING [GlobalFrameHandle],
  DiskDefs USING [DiskRequest, SwapPages],
  FrameOps USING [FlushLargeFrames],
  InlineDefs USING [BITAND, DIVMOD, LongCOPY],
  NucleusOps USING [],
  ProcessDefs USING [DisableInterrupts, EnableInterrupts],
  Region USING [Count, Handle, Index, Page, PagesPerRegion],
  SegmentDefs USING [
    AccessOptions, AddressFromPage, AllocInfo, ChangeDataToFileSegment,
    DataSegmentHandle, DefaultANYBase, DefaultBase, DefaultBase0, DefaultBase1,
    DefaultBase2, DefaultBase3, DefaultMDSBase, DefaultXMBase, DeleteFileSegment,
    EasyDown, EasyUp, FileHandle, FileHint, FileSegmentHandle, Frob, FrobHandle,
    FrobLink, FrobNull, FrobSize, InvalidSegmentSize, LongAddressFromPage,
    MakeSwappedIn, MaxRefs, MaxSegLocks, NewFileSegment, Object, ObjectHandle,
    ObjectType, OpenFile, PageCount, PageNumber, PagePointer, Read, RefCount,
    RemoteSegCommand, RemoteSegProc, SegLockCount, SegmentHandle, SegmentLocation,
    SegmentType, SwapIn, TableDS, Write],
  SwapperOps USING [
    BusyPage, FreePage, PositionSeg, RegionTable, SystemTable, Table, TableHandle,
    UpdateCodebases];

Swapper: PROGRAM
  IMPORTS SwapperOps, DiskDefs, FrameOps, InlineDefs, ProcessDefs, SegmentDefs
  EXPORTS AllocDefs, SwapperOps, FrameDefs, FrameOps, NucleusOps, SegmentDefs
  SHARES SegmentDefs =
  BEGIN OPEN AltoDefs, SwapperOps, AllocDefs, Region, SegmentDefs;

  regions: PUBLIC RegionTable;
  systemTable: PUBLIC SystemTable;

  -- Data Segments


  MakeDataSegment: PUBLIC PROCEDURE [
    base: PageNumber, pages: PageCount, info: AllocInfo]
    RETURNS [seg: DataSegmentHandle] =
    BEGIN
    IF pages ~IN (0..PagesPerRegion] THEN ERROR InvalidSegmentSize[pages];
    seg _ FixDataSegment[base: AllocVM[base, pages, info, NIL], pages: pages];
    END;

  FixDataSegment, BootDataSegment: PUBLIC PROCEDURE [
    base: PageNumber, pages: PageCount] RETURNS [seg: DataSegmentHandle] =
    BEGIN
    seg _ LOOPHOLE[AllocateObject[SIZE[data segment Object]]];
    seg^ _ [body: segment[VMpage: base, info: data[type:, pages: pages]]];
    UpdateVM[base, pages, seg];
    RETURN
    END;

  DeleteDataSegment: PUBLIC PROCEDURE [seg: DataSegmentHandle] =
    BEGIN
    base: PageNumber;
    pages: PageCount;
    ValidateObject[seg];
    UpdateVM[base _ seg.VMpage, pages _ seg.pages, BusyPage];
    LiberateObject[seg];
    UpdateVM[base, pages, FreePage];
    RETURN
    END;

  DataSegmentAddress: PUBLIC PROCEDURE [seg: SegmentHandle] RETURNS [POINTER] =
    BEGIN
    IF seg.VMpage > MaxMDSPage THEN ERROR InvalidObject[seg];
    RETURN[AddressFromPage[seg.VMpage]]
    END;

  -- Swapping Segments

  SwapError: PUBLIC SIGNAL [seg: FileSegmentHandle] = CODE;

  MakeSwappedIn: PUBLIC PROCEDURE [
    seg: FileSegmentHandle, base: PageNumber, info: AllocInfo] =
    BEGIN OPEN ProcessDefs;
    vmpage: PageNumber;
    pages: CARDINAL;
    IF seg.lock = MaxSegLocks THEN ERROR SwapError[seg];
    ValidateObject[seg];
    ProcessDefs.DisableInterrupts[];
    IF seg.swappedin THEN
      BEGIN seg.lock _ seg.lock + 1; ProcessDefs.EnableInterrupts[]; RETURN END;
    ProcessDefs.EnableInterrupts[];
    IF seg.file.swapcount = MaxRefs THEN SIGNAL SwapError[seg];
    IF ~seg.file.open THEN OpenFile[seg.file];
    vmpage _ AllocVM[base, pages _ seg.pages, info, seg];
    -- There is a funny side-effect of AllocVM that we have to worry about.  In the course
    -- of allocating space for the segment, it is possible that segments have been swapped in
    -- (in order to call swapping procedures or execute instructions implemented in software).
    -- In particular, it is possible that 'seg' itself has been swapped in this way.  The exits
    -- in the following block of code deal with this possibility.
    BEGIN -- block for funny cases --
    ENABLE UNWIND => UpdateVM[vmpage, pages, FreePage];
    DisableInterrupts[];
    IF seg.swappedin THEN
      BEGIN seg.lock _ seg.lock + 1; EnableInterrupts[]; GO TO Surprise END;
    EnableInterrupts[];
    WITH s: seg SELECT FROM
      disk =>
	IF vmpage > MaxMDSPage THEN
	  BEGIN
	  MakeSwappedIn[@s, DefaultMDSBase, EasyUp];
	  IF s.VMpage > MaxMDSPage THEN
	    BEGIN seg.lock _ seg.lock + 1; GO TO Surprise END;
	  -- already in an XM bank --
	  InlineDefs.LongCOPY[
	    from: LongAddressFromPage[s.VMpage], to: LongAddressFromPage[vmpage],
	    nwords: pages*PageSize];
	  UpdateVM[s.VMpage, pages, FreePage];
	  s.VMpage _ vmpage;
	  DisableInterrupts[];
	  END
	ELSE
	  BEGIN
	  seg.VMpage _ vmpage;
	  IF (s.hint.page # s.base OR s.hint.da = AltoFileDefs.eofDA) AND
	    SwapperOps.PositionSeg[@s, TRUE] AND s.pages = 1 THEN NULL
	  ELSE MapVM[@s, ReadD];
	  GO TO BumpCounts
	  END;
      remote => BEGIN s.proc[@s, remoteRead]; GO TO BumpCounts END;
      ENDCASE;
    EXITS
      BumpCounts =>
	BEGIN
	DisableInterrupts[];
	seg.file.swapcount _ seg.file.swapcount + 1;
	seg.lock _ seg.lock + 1;
	seg.swappedin _ TRUE;
	END;
      Surprise => BEGIN UpdateVM[vmpage, pages, FreePage]; RETURN END;
    END; -- block for funny cases --
    UpdateVM[vmpage, pages, seg];
    EnableInterrupts[];
    RETURN
    END;

  Unlock: PUBLIC PROCEDURE [seg: FileSegmentHandle] =
    BEGIN OPEN seg;
    IF lock = 0 THEN ERROR SwapError[seg];
    ValidateObject[seg];
    ProcessDefs.DisableInterrupts[];
    lock _ lock - 1;
    ProcessDefs.EnableInterrupts[];
    RETURN
    END;

  SwapUp: PUBLIC PROCEDURE [seg: FileSegmentHandle] =
    BEGIN OPEN seg;
    ValidateObject[seg];
    IF swappedin AND write THEN
      WITH s: seg SELECT FROM
	disk =>
	  IF s.VMpage <= MaxMDSPage THEN
	    BEGIN
	    IF s.hint.page # base OR s.hint.da = AltoFileDefs.eofDA THEN
	      [] _ SwapperOps.PositionSeg[@s, FALSE];
	    MapVM[@s, WriteD];
	    END
	  ELSE
	    BEGIN
	    pages: CARDINAL = s.pages;
	    mdsFileSeg: FileSegmentHandle _ NewFileSegment[
	      file, s.base, pages, Read + Write];
	    mdsDataSeg: DataSegmentHandle _ MakeDataSegment[
	      DefaultMDSBase, pages, EasyDown];
	    InlineDefs.LongCOPY[
	      from: LongAddressFromPage[s.VMpage],
	      to: LongAddressFromPage[mdsDataSeg.VMpage], nwords: pages*PageSize];
	    ChangeDataToFileSegment[mdsDataSeg, mdsFileSeg];
	    Unlock[mdsFileSeg];
	    DeleteFileSegment[mdsFileSeg];
	    END;
	remote => s.proc[@s, remoteWrite];
	ENDCASE;
    RETURN
    END;

  SwapOut: PUBLIC PROCEDURE [seg: FileSegmentHandle] =
    BEGIN OPEN seg;
    temp: PageNumber; -- ValidateObject[seg]; --
    SwapUp[seg];
    ProcessDefs.DisableInterrupts[];
    IF ~swappedin THEN BEGIN ProcessDefs.EnableInterrupts[]; RETURN END;
    IF lock # 0 THEN
      BEGIN ProcessDefs.EnableInterrupts[]; ERROR SwapError[seg] END;
    busy _ TRUE;
    UpdateVM[temp _ VMpage, pages, BusyPage];
    swappedin _ FALSE;
    busy _ FALSE;
    file.swapcount _ file.swapcount - 1;
    ProcessDefs.EnableInterrupts[];
    UpdateVM[temp, pages, FreePage];
    RETURN
    END;

  remoteRead: RemoteSegCommand = 0;
  remoteWrite: RemoteSegCommand = 1;

  SegmentFault: PUBLIC SIGNAL [seg: FileSegmentHandle, pages: PageCount] = CODE;

  MapVM: PUBLIC PROCEDURE [seg: FileSegmentHandle, dc: AltoFileDefs.vDC] =
    BEGIN OPEN seg;
    page: PageNumber;
    byte: CARDINAL;
    temp: PageCount;
    arg: swap DiskDefs.DiskRequest;
    WITH s: seg SELECT FROM
      disk =>
	BEGIN
	arg _ DiskDefs.DiskRequest[
	  AddressFromPage[s.VMpage], @s.hint.da, s.base, s.base + s.pages - 1,
	  @s.file.fp, FALSE, dc, dc, FALSE, swap[NIL]];
	IF s.hint.page # s.base THEN ERROR SwapError[@s];
	[page, byte] _ DiskDefs.SwapPages[@arg];
	temp _ page - base + (IF byte = 0 THEN 0 ELSE 1);
	IF temp = 0 THEN ERROR SegmentFault[@s, 0];
	IF temp # pages THEN
	  BEGIN
	  SIGNAL SegmentFault[@s, temp];
	  UpdateVM[s.VMpage + temp, s.pages - temp, FreePage];
	  s.pages _ temp;
	  END;
	END;
      remote => ERROR SwapError[@s];
      ENDCASE;
    RETURN
    END;

  SwapOutCodeSeg: PUBLIC PROCEDURE [seg: FileSegmentHandle] =
    BEGIN
    ProcessDefs.DisableInterrupts[];
    IF seg.swappedin THEN
      BEGIN
      SwapIn[seg]; -- lock it so it won't go away
      UpdateCodebases[seg];
      Unlock[seg];
      SwapOut[seg];
      END;
    ProcessDefs.EnableInterrupts[];
    RETURN
    END;

  SwapInCode: PUBLIC PROCEDURE [f: ControlDefs.GlobalFrameHandle] =
    BEGIN
    seg: FileSegmentHandle;
    page: PageNumber;
    -- It is believed that Disabling during SwapIn is unnecessary
    -- as long as ALL interrupt code is locked.  The
    -- Swapper should have segment locks to help fix this.
    seg _ CodeHandle[f];
    MakeSwappedIn[seg, DefaultBase, [easy, bottomup, code]];
    ProcessDefs.DisableInterrupts[];
    IF f.code.out THEN
      BEGIN
      offset: CARDINAL _ f.code.offset;
      -- Don't call FileSegmentAddress; it's not locked!
      IF (page _ seg.VMpage) <= MaxMDSPage THEN
	BEGIN
	f.code.shortbase _ AddressFromPage[page] + offset;
	f.code.handle _ seg;
	END
      ELSE f.code.longbase _ LongAddressFromPage[page] + offset;
      f.code.out _ FALSE;
      END;
    ProcessDefs.EnableInterrupts[];
    RETURN
    END;

  CodeHandle: PUBLIC PROCEDURE [f: ControlDefs.GlobalFrameHandle]
    RETURNS [FileSegmentHandle] =
    BEGIN
    relPage: Region.Page;
    IF f.code.highByte # 0 THEN RETURN[f.code.handle];
    relPage _ f.code.offset/AltoDefs.PageSize;
    RETURN[LOOPHOLE[regions[f.code.highHalf].status[relPage].seg]]
    END;

  ReleaseCode: PUBLIC PROCEDURE [f: ControlDefs.GlobalFrameHandle] =
    BEGIN Unlock[CodeHandle[f]]; RETURN END;

  -- Memory Allocator

  mdsIndex: PUBLIC Region.Index;

  AllocVM: PUBLIC PROCEDURE [
    base: PageNumber, pages: PageCount, info: AllocInfo, seg: SegmentHandle]
    RETURNS [PageNumber] =
    BEGIN
    i, start: Region.Index;
    baseCopy: PageNumber _ DefaultBase;
    region: Region.Handle;
    page: PageNumber;
    found, anyWhere, oneRegion, useMDS: BOOLEAN;
    FlushAndEnsureFrames[];
    DO
      -- loop so that we can retry if InsufficientVM is RESUMEd
      useMDS _ anyWhere _ TRUE;
      IF base <= MaxVMPage THEN
	BEGIN
	[quotient: i, remainder: baseCopy] _ InlineDefs.DIVMOD[
	  base, PagesPerRegion];
	IF baseCopy + pages > Region.PagesPerRegion THEN GOTO badRequest;
	anyWhere _ FALSE;
	start _ i;
	oneRegion _ TRUE;
	END
      ELSE
	SELECT base FROM
	  DefaultMDSBase => {start _ i _ 0; oneRegion _ TRUE};
	  DefaultXMBase => {useMDS _ FALSE; start _ i _ 1; oneRegion _ FALSE};
	  DefaultANYBase => {start _ i _ 1; oneRegion _ FALSE};
	  DefaultBase =>
	    IF info.class = code THEN {start _ i _ 1; oneRegion _ FALSE}
	    ELSE {start _ i _ 0; oneRegion _ TRUE};
	  DefaultBase0 => {start _ i _ 0; oneRegion _ TRUE};
	  DefaultBase1 => {start _ i _ 1; oneRegion _ TRUE};
	  DefaultBase2 => {start _ i _ 2; oneRegion _ TRUE};
	  DefaultBase3 => {start _ i _ 3; oneRegion _ TRUE};
	  ENDCASE => GOTO badRequest;
      DO
	region _ regions[i];
	IF region # NIL AND (info.effort # easy OR region.hole >= pages) THEN
	  BEGIN
	  [found, page] _ region.alloc[baseCopy, pages, info, anyWhere];
	  IF found THEN RETURN[page + region.basePage];
	  END;
	IF oneRegion OR i = 0 THEN EXIT;
	IF i # LAST[Region.Index] THEN i _ i + 1
	ELSE IF ~useMDS THEN EXIT ELSE i _ 0;
	ENDLOOP;
      IF anyWhere AND info.class > table THEN
	BEGIN
	i _ start;
	DO
	  region _ regions[i];
	  IF region # NIL THEN
	    WHILE region.swap[pages, info, seg] DO
	      [found, page] _ region.alloc[baseCopy, pages, info, anyWhere];
	      IF found THEN RETURN[page + region.basePage]
	      ENDLOOP;
	  IF oneRegion OR i = 0 THEN EXIT;
	  IF i # LAST[Region.Index] THEN i _ i + 1
	  ELSE IF ~useMDS THEN EXIT ELSE i _ 0;
	  ENDLOOP;
	END;
      IF anyWhere THEN SIGNAL InsufficientVM[pages]
      ELSE SIGNAL VMnotFree[base, pages];
      REPEAT badRequest => ERROR InvalidMemoryRequest[base, pages];
      ENDLOOP;
    END;

  -- FlushAndEnsureFrames' frame must be larger than
  --   MDSRegion Alloc's frame
  -- FlushLargeFrames' frame must be larger than MDSRegion Update's frame


  FlushAndEnsureFrames: PROCEDURE =
    BEGIN
    dummy: ARRAY [0..11) OF CARDINAL;
    IF FALSE THEN dummy[0] _ 0;
    FrameOps.FlushLargeFrames[];
    END;

  InvalidMemoryRequest: PUBLIC SIGNAL [base: PageNumber, pages: PageCount] = CODE;

  InsufficientVM: PUBLIC SIGNAL [needed: PageCount] = CODE;
  VMnotFree: PUBLIC SIGNAL [base: PageNumber, pages: PageCount] = CODE;

  UpdateVM: PUBLIC PROCEDURE [
    base: PageNumber, pages: PageCount, seg: SegmentHandle] =
    BEGIN
    index: Region.Index;
    r: Region.Handle;
    relPage: Page;
    [index, relPage] _ InlineDefs.DIVMOD[base, PagesPerRegion];
    IF index > LAST[Region.Index] OR (r _ regions[index]) = NIL THEN ERROR;
    r.update[relPage, pages, seg, FALSE];
    RETURN
    END;

  -- Primative Object Allocation

  ObjectSeal: AltoDefs.BYTE = 21B;

  InvalidObject: PUBLIC SIGNAL [object: POINTER] = CODE;

  AllocateObject: PUBLIC PROCEDURE [size: CARDINAL] RETURNS [ObjectHandle] =
    BEGIN OPEN SwapperOps;
    frob: FrobLink;
    frobject: FrobHandle;
    table: TableHandle;
    base, length: CARDINAL;
    ProcessDefs.DisableInterrupts[];
    FOR table _ systemTable.table, table.link UNTIL table = NIL DO
      IF table.free.fwdp # FIRST[FrobLink] THEN
	BEGIN
	base _ LOOPHOLE[table, CARDINAL];
	FOR frob _ table.free.fwdp, frobject.fwdp UNTIL frob = FIRST[FrobLink] DO
	  frobject _ base + frob;
	  length _ frobject.size;
	  UNTIL frob + length > FrobNull DO
	    WITH n: LOOPHOLE[frobject + length, ObjectHandle] SELECT FROM
	      free => -- coalesce nodes
		BEGIN
		(base + n.fwdp).backp _ n.backp;
		(base + n.backp).fwdp _ n.fwdp;
		length _ length + n.size;
		END;
	      ENDCASE => EXIT;
	    ENDLOOP;
	  SELECT length FROM
	    = size =>
	      BEGIN
	      (base + frobject.fwdp).backp _ frobject.backp;
	      (base + frobject.backp).fwdp _ frobject.fwdp;
	      table.free.size _ table.free.size + size;
	      ProcessDefs.EnableInterrupts[];
	      RETURN[frobject];
	      END;
	    > size =>
	      BEGIN
	      frobject.size _ length - size;
	      table.free.size _ table.free.size + size;
	      ProcessDefs.EnableInterrupts[];
	      RETURN[frobject + length - size];
	      END;
	    ENDCASE => frobject.size _ length;
	  ENDLOOP;
	END;
      ENDLOOP;
    table _ AllocateTable[ ! UNWIND => ProcessDefs.EnableInterrupts[]];
    frob _ table.free.fwdp;
    frobject _ LOOPHOLE[table, CARDINAL] + frob;
    frobject.size _ frobject.size - size;
    table.free.size _ table.free.size + size;
    ProcessDefs.EnableInterrupts[];
    RETURN[frobject + frobject.size];
    END;

  LiberateObject: PUBLIC PROCEDURE [object: ObjectHandle] =
    BEGIN OPEN SegmentDefs;
    table: TableHandle _ PagePointer[object];
    size, base: CARDINAL;
    frob: FrobLink _ InlineDefs.BITAND[object, 377B];
    base _ LOOPHOLE[table];
    size _
      WITH o: object SELECT FROM
	segment =>
	  SELECT o.type FROM
	    data => SIZE[data segment Object],
	    ENDCASE => SIZE[file segment Object],
	file => SIZE[file Object],
	ENDCASE => SIZE[length Object];
    ProcessDefs.DisableInterrupts[];
    IF (table.free.size _ table.free.size - size) = 0 THEN
      LiberateTable[table ! UNWIND => ProcessDefs.EnableInterrupts[]]
    ELSE
      BEGIN
      object^ _ Object[
	FALSE, free[seal: ObjectSeal, size:, fwdp:, backp: FIRST[FrobLink]]];
      LOOPHOLE[object, FrobHandle].size _ size;
      LOOPHOLE[object, FrobHandle].fwdp _ table.free.fwdp;
      (base + table.free.fwdp).backp _ frob;
      table.free.fwdp _ frob;
      END;
    ProcessDefs.EnableInterrupts[];
    RETURN
    END;

  AllocateTable: PROCEDURE RETURNS [newTable: TableHandle] =
    BEGIN OPEN SwapperOps, SegmentDefs;
    frob: FrobLink = LOOPHOLE[SIZE[Table]];
    base: CARDINAL;
    page: PageNumber = AllocVM[DefaultMDSBase, 1, [hard, topdown, table], NIL];
    newTable _ AddressFromPage[page];
    newTable^ _ Table[
      [FALSE, free[ObjectSeal, 0, frob, frob]], systemTable.table, NIL];
    base _ LOOPHOLE[newTable];
    (base + frob)^ _
      [FALSE, free[
	ObjectSeal, AltoDefs.PageSize - SIZE[Table], FIRST[FrobLink], FIRST[
	FrobLink]]];
    systemTable.table _ newTable;
    (systemTable.table.seg _ FixDataSegment[page, 1]).type _ TableDS;
    RETURN
    END;

  LiberateTable: PROCEDURE [table: TableHandle] =
    BEGIN
    current: TableHandle;
    prev: TableHandle _ NIL;
    FOR current _ systemTable.table, current.link UNTIL current = NIL DO
      IF current = table THEN
	BEGIN
	IF prev = NIL THEN systemTable.table _ current.link
	ELSE prev.link _ current.link; -- oops: this had better not recur!
	DeleteDataSegment[current.seg];
	RETURN
	END;
      prev _ current;
      ENDLOOP;
    ERROR InvalidObject[table];
    END;

  ValidateObject: PUBLIC PROCEDURE [object: ObjectHandle] =
    BEGIN
    table: TableHandle = PagePointer[object];
    BEGIN
    IF object = NIL OR InlineDefs.BITAND[LOOPHOLE[object, CARDINAL], 1] = 1 OR
      object.tag = free THEN GOTO invalid;
    IF table.free.seal # ObjectSeal THEN GOTO invalid;
    EXITS invalid => ERROR InvalidObject[object];
    END;
    RETURN
    END;

  EnumerateObjects: PUBLIC PROCEDURE [
    type: ObjectType, proc: PROCEDURE [ObjectHandle] RETURNS [BOOLEAN]]
    RETURNS [object: ObjectHandle] =
    BEGIN OPEN SegmentDefs;
    i, j: CARDINAL;
    table: TableHandle;
    FOR table _ systemTable.table, table.link UNTIL table = NIL DO
      j _ i _ SIZE[SwapperOps.Table];
      FOR object _ @table.free + i, object + i UNTIL j >= AltoDefs.PageSize DO
	i _
	  WITH obj: object SELECT FROM
	    segment =>
	      SELECT obj.type FROM
		data => SIZE[data segment Object],
		ENDCASE => SIZE[file segment Object],
	    file => SIZE[file Object],
	    free => obj.size,
	    ENDCASE => SIZE[length Object];
	j _ j + i;
	IF object.tag = type AND proc[object] THEN RETURN[object];
	ENDLOOP;
      ENDLOOP;
    RETURN[NIL]
    END;


  END.....