-- Modules.mesa  Last edited by Sandman, July 1, 1980  8:22 AM
-- Copyright  Xerox Corporation 1979, 1980

DIRECTORY
  ControlDefs USING [
    ControlLink, ControlModule, EntryInfo, EPRange, FrameCodeBase, FrameHandle,
    GFT, GFTIndex, GFTItem, GlobalFrameHandle, MainBodyIndex, LastAVSlot,
    NullControl, NullEpBase, NullFrame, NullGlobalFrame, PrefixHandle, PrefixInfo,
    StateVector, SVPointer, WordPC],
  FrameDefs USING [
    EnterGlobalFrame, EnumerateGlobalFrames, RemoveGlobalFrame, SwapInCode,
    ValidateGlobalFrame],
  FrameOps USING [
    Alloc, CodeHandle, FrameSize, Free, GetReturnLink, ReleaseCode,
    SetReturnFrame, ValidGlobalFrame],
  InlineDefs USING [BITAND, COPY],
  LoadStateFormat USING [NullModule],
  LoadStateOps USING [EnterModule, GetModule, InputLoadState, ReleaseLoadState],
  Mopcodes USING [zDESCBS, zRBL, zSFC],
  NucleusOps USING [],
  Runtime USING [],
  SDDefs USING [sCopy, SD, sGFTLength, sUnNew],
  SDOps USING [],
  SegmentDefs USING [
    AddressFromPage, DeleteFileSegment, FileSegmentHandle, SwapError, Unlock],
  TrapDefs USING [UnboundProcedure];

Modules: PROGRAM
  IMPORTS FrameDefs, FrameOps, InlineDefs, LoadStateOps, SegmentDefs, TrapDefs
  EXPORTS FrameDefs, FrameOps, NucleusOps, Runtime, SDOps, TrapDefs
  SHARES ControlDefs =
  BEGIN OPEN ControlDefs;

  StartFault: PUBLIC SIGNAL [dest: UNSPECIFIED] = CODE;

  MainBody: PROCEDURE [GlobalFrameHandle] RETURNS [ControlLink] = MACHINE CODE
    BEGIN Mopcodes.zDESCBS, 0 END;

  Call: PROCEDURE [ControlLink] = MACHINE CODE BEGIN Mopcodes.zSFC END;

  Start: PUBLIC PROCEDURE [cm: ControlModule] =
    BEGIN
    state: StateVector;
    state _ STATE;
    IF ~cm.multiple THEN
      BEGIN
      IF cm.frame = NullGlobalFrame OR cm.frame.started THEN
	ERROR StartFault[cm.frame];
      FrameDefs.ValidateGlobalFrame[cm.frame];
      StartCM[cm.frame.global[0], cm.frame, @state];
      IF ~cm.frame.started THEN
	BEGIN cm.frame.started _ TRUE; StartWithState[cm.frame, @state]; END
      ELSE IF state.stkptr # 0 THEN SIGNAL StartFault[cm];
      END
    ELSE
      BEGIN
      StartCM[cm, NIL, NIL];
      IF state.stkptr # 0 THEN SIGNAL StartFault[cm];
      END;
    RETURN
    END;

  StartCM: PROCEDURE [
    cm: ControlModule, frame: GlobalFrameHandle, state: ControlDefs.SVPointer] =
    BEGIN
    SELECT TRUE FROM
      cm = NullControl => RETURN;
      cm.multiple =>
	BEGIN
	i, length: CARDINAL;
	cm.multiple _ FALSE;
	IF (length _ cm.list.nModules) = 0 THEN RETURN;
	cm.list.nModules _ 0;
	FOR i IN [0..length) DO
	  StartCM[[frame[cm.list.frames[i]]], frame, state]; ENDLOOP;
	FrameOps.Free[cm.list];
	END;
      cm.frame.started => RETURN;
      ENDCASE =>
	BEGIN
	control: ControlModule _ cm.frame.global[0];
	IF control # cm THEN StartCM[control, frame, state];
	IF ~cm.frame.started THEN
	  BEGIN
	  cm.frame.started _ TRUE;
	  IF frame # cm.frame THEN Call[MainBody[cm.frame]]
	  ELSE StartWithState[frame, state];
	  END;
	END;
    RETURN
    END;

  StartWithState: PROCEDURE [
    frame: GlobalFrameHandle, state: ControlDefs.SVPointer] =
    BEGIN OPEN ControlDefs;
    s: StateVector _ state^;
    retFrame: FrameHandle _ FrameOps.GetReturnLink[].frame;
    s.dest _ MainBody[frame];
    s.source _ retFrame.returnlink;
    FrameOps.Free[retFrame];
    RETURN WITH s;
    END;

  Restart: PUBLIC PROCEDURE [dest: GlobalFrameHandle] =
    BEGIN
    stops: BOOLEAN;
    frame: FrameHandle;
    IF dest = NullGlobalFrame THEN ERROR StartFault[dest];
    FrameDefs.ValidateGlobalFrame[dest];
    IF ~dest.started THEN Start[[frame[dest]]];
    FrameDefs.SwapInCode[dest];
    IF dest.code.highByte = 0 THEN
      BEGIN

      GetPrefixInfo: PROCEDURE [LONG POINTER] RETURNS [PrefixInfo] = MACHINE CODE
	BEGIN Mopcodes.zRBL, 1 END;

      stops _ GetPrefixInfo[dest.code.longbase].stops;
      END
    ELSE stops _ LOOPHOLE[dest.code.shortbase, PrefixHandle].header.info.stops;
    FrameOps.ReleaseCode[dest];
    IF ~stops THEN ERROR StartFault[dest];
    IF (frame _ dest.global[0]) # NullFrame THEN
      BEGIN
      frame.returnlink _ FrameOps.GetReturnLink[];
      FrameOps.SetReturnFrame[frame];
      END;
    RETURN
    END;

  -- Global Frame Table management

  gftrover: CARDINAL _ 0; -- okay to start at 0 because incremented before used

  NoGlobalFrameSlots: PUBLIC SIGNAL [CARDINAL] = CODE;

  EnumerateGlobalFrames: PUBLIC PROCEDURE [
    proc: PROCEDURE [GlobalFrameHandle] RETURNS [BOOLEAN]]
    RETURNS [GlobalFrameHandle] =
    BEGIN
    i: GFTIndex;
    frame: GlobalFrameHandle;
    gft: POINTER TO ARRAY [0..0) OF GFTItem _ GFT;
    FOR i IN [0..SDDefs.SD[SDDefs.sGFTLength]) DO
      frame _ gft[i].frame;
      IF frame # NullGlobalFrame AND gft[i].epbase = 0 AND proc[frame] THEN
	RETURN[frame];
      ENDLOOP;
    RETURN[NullGlobalFrame]
    END;

  EnterGlobalFrame: PUBLIC PROCEDURE [frame: GlobalFrameHandle, nslots: CARDINAL]
    RETURNS [entryindex: GFTIndex] =
    BEGIN
    gft: POINTER TO ARRAY [0..0) OF GFTItem _ GFT;
    i, imax, n, epoffset: CARDINAL;
    i _ gftrover;
    imax _ SDDefs.SD[SDDefs.sGFTLength] - nslots;
    n _ 0;
    DO
      IF (i _ IF i >= imax THEN 1 ELSE i + 1) = gftrover THEN
	SIGNAL NoGlobalFrameSlots[nslots];
      IF gft[i].frame # NullGlobalFrame THEN n _ 0
      ELSE
	IF gft[i].epbase = NullEpBase THEN n _ 0
	ELSE IF (n _ n + 1) = nslots THEN EXIT;
      ENDLOOP;
    entryindex _ (gftrover _ i) - nslots + 1;
    epoffset _ 0;
    FOR i IN [entryindex..gftrover] DO
      gft[i] _ GFTItem[frame, epoffset]; epoffset _ epoffset + EPRange; ENDLOOP;
    RETURN
    END;

  RemoveGlobalFrame: PUBLIC PROCEDURE [frame: GlobalFrameHandle] =
    BEGIN
    gft: POINTER TO ARRAY [0..0) OF GFTItem _ GFT;
    sd: POINTER TO ARRAY [0..0) OF CARDINAL _ SDDefs.SD;
    i: CARDINAL;
    FOR i _ frame.gfi, i + 1 WHILE i < sd[SDDefs.sGFTLength] AND gft[i].frame =
      frame DO
      gft[i] _
	IF frame.copied THEN GFTItem[NullGlobalFrame, 0]
	ELSE GFTItem[NullGlobalFrame, NullEpBase];
      ENDLOOP;
    RETURN
    END;

  -- Frame manipulation


  GlobalFrame: PUBLIC PROCEDURE [link: UNSPECIFIED] RETURNS [UNSPECIFIED] =
    BEGIN OPEN l: LOOPHOLE[link, ControlLink];
    DO
      SELECT l.tag FROM
	frame =>
	  BEGIN
	  IF link = 0 THEN RETURN[NullGlobalFrame];
	  IF FrameOps.ValidGlobalFrame[link] THEN RETURN[link];
	  IF FrameOps.ValidGlobalFrame[l.frame.accesslink] THEN
	    RETURN[l.frame.accesslink];
	  RETURN[NullGlobalFrame]
	  END;
	procedure => RETURN[GFT[l.gfi].frame];
	indirect => link _ l.link^;
	unbound => link _ SIGNAL TrapDefs.UnboundProcedure[link];
	ENDCASE
      ENDLOOP
    END;

  Copy: PUBLIC PROCEDURE [old: GlobalFrameHandle]
    RETURNS [new: GlobalFrameHandle] =
    BEGIN
    linkspace, ngfi: CARDINAL _ 0;
    long: BOOLEAN;
    seg: SegmentDefs.FileSegmentHandle;
    FrameDefs.ValidateGlobalFrame[old];
    seg _ FrameOps.CodeHandle[old];
    FrameDefs.SwapInCode[old];
    IF (long _ old.code.highByte = 0) THEN
      [new, linkspace, ngfi] _ AllocLongGlobalFrame[old]
    ELSE [new, linkspace, ngfi] _ AllocGlobalFrame[old];
    new _ new + linkspace;
    new^ _
      [gfi:, unused: 0, alloced: TRUE, shared: TRUE, copied: TRUE, started: FALSE,
	trapxfers: FALSE, codelinks: old.codelinks, code: old.code, global:];
    new.gfi _ FrameDefs.EnterGlobalFrame[new, ngfi];
    IF seg # NIL THEN
      BEGIN
      new.code.offset _
	old.code.shortbase - SegmentDefs.AddressFromPage[seg.VMpage];
      new.code.handle _ seg;
      END;
    new.code.out _ TRUE;
    new.global[0] _ NullGlobalFrame;
    old.shared _ TRUE;
    IF linkspace # 0 THEN
      InlineDefs.COPY[
	from: old - linkspace, to: new - linkspace, nwords: linkspace];
    FrameOps.ReleaseCode[old];
    RETURN
    END;

  MakeFsi: PUBLIC PROCEDURE [words: CARDINAL] RETURNS [fsi: CARDINAL] =
    BEGIN
    FOR fsi IN [0..LastAVSlot] DO
      IF FrameOps.FrameSize[fsi] >= words THEN RETURN; ENDLOOP;
    RETURN[words]
    END;

  AllocGlobalFrame: PROCEDURE [old: GlobalFrameHandle]
    RETURNS [frame: GlobalFrameHandle, linkspace, ngfi: CARDINAL] =
    BEGIN
    pbody: POINTER;
    cp: PrefixHandle _ old.code.shortbase;
    pbody _ cp + CARDINAL[cp.entry[MainBodyIndex].initialpc];
    linkspace _
      IF ~old.codelinks THEN
      cp.header.info.nlinks + InlineDefs.BITAND[
	-LOOPHOLE[cp.header.info.nlinks, INTEGER], 3B] ELSE 0;
    frame _ FrameOps.Alloc[MakeFsi[(pbody - 1)^ + linkspace]];
    ngfi _ cp.header.info.ngfi;
    RETURN
    END;

  GetPrefixInfo: PROCEDURE [LONG POINTER] RETURNS [PrefixInfo] = MACHINE CODE
    BEGIN Mopcodes.zRBL, 1 END;

  GetEntryInfo: PROCEDURE [LONG POINTER] RETURNS [EntryInfo] = MACHINE CODE
    BEGIN Mopcodes.zRBL, 1 END;

  GetInitialPC: PROCEDURE [LONG POINTER] RETURNS [WordPC] = MACHINE CODE
    BEGIN Mopcodes.zRBL, 0 END;

  GetFSize: PROCEDURE [LONG POINTER] RETURNS [CARDINAL] = MACHINE CODE
    BEGIN Mopcodes.zRBL, 0 END;

  AllocLongGlobalFrame: PROCEDURE [old: GlobalFrameHandle]
    RETURNS [frame: GlobalFrameHandle, linkspace, ngfi: CARDINAL] =
    BEGIN
    p: LONG POINTER;
    fsi: CARDINAL;
    initialpc: WordPC;
    cp: LONG PrefixHandle _ old.code.longbase;
    prefix: PrefixInfo _ GetPrefixInfo[cp];
    entryInfo: EntryInfo;
    p _ @cp.entry[MainBodyIndex];
    entryInfo _ GetEntryInfo[p];
    initialpc _ GetInitialPC[p];
    p _ cp + initialpc - 1;
    linkspace _
      IF ~old.codelinks THEN
      prefix.nlinks + InlineDefs.BITAND[-LOOPHOLE[prefix.nlinks, INTEGER], 3B]
      ELSE 0;
    fsi _ GetFSize[p];
    frame _ FrameOps.Alloc[MakeFsi[fsi + linkspace]];
    ngfi _ prefix.ngfi;
    RETURN
    END;

  UnNewModule: PROCEDURE [frame: GlobalFrameHandle] =
    BEGIN
    cseg: SegmentDefs.FileSegmentHandle;
    sharer: GlobalFrameHandle _ NullGlobalFrame;
    original: GlobalFrameHandle _ NullGlobalFrame;
    copy: GlobalFrameHandle _ NullGlobalFrame;
    fcb: FrameCodeBase;
    nothers: CARDINAL _ 0;
    nlinks: CARDINAL;
    long: BOOLEAN;

    RemoveAllTraces: PROCEDURE [f: GlobalFrameHandle] RETURNS [BOOLEAN] =
      BEGIN
      cm: CodeMatch;
      IF f # frame THEN
	BEGIN
	IF f.global[0] = frame AND ~f.started THEN f.global[0] _ NullFrame;
	cm _ SameCode[f, frame];
	IF cm # different THEN
	  BEGIN
	  nothers _ nothers + 1;
	  sharer _ f;
	  IF cm = identical THEN IF f.copied THEN copy _ f ELSE original _ f;
	  END;
	END;
      RETURN[FALSE];
      END;

    FrameDefs.ValidateGlobalFrame[frame];
    cseg _ FrameOps.CodeHandle[frame];
    FrameDefs.SwapInCode[frame];
    fcb _ frame.code;
    IF (long _ frame.code.highByte = 0) THEN
      BEGIN
      prefix: PrefixInfo _ GetPrefixInfo[frame.code.longbase];
      nlinks _ prefix.nlinks
      END
    ELSE
      BEGIN
      nlinks _ LOOPHOLE[frame.code.shortbase, PrefixHandle].header.info.nlinks;
      fcb.offset _
	frame.code.shortbase - SegmentDefs.AddressFromPage[cseg.VMpage];
      fcb.out _ TRUE;
      END;
    [] _ FrameDefs.EnumerateGlobalFrames[RemoveAllTraces];
    IF cseg # NIL THEN SegmentDefs.Unlock[cseg];
    IF original = NullGlobalFrame AND ~frame.copied AND copy # NullGlobalFrame
      THEN
      BEGIN OPEN LoadStateOps;
      copy.copied _ FALSE;
      [] _ InputLoadState[];
      EnterModule[rgfi: copy.gfi, module: GetModule[frame.gfi]];
      EnterModule[rgfi: frame.gfi, module: LoadStateFormat.NullModule];
      ReleaseLoadState[];
      END;
    IF frame.shared THEN BEGIN IF nothers = 1 THEN sharer.shared _ FALSE END
    ELSE
      IF cseg # NIL THEN
	BEGIN OPEN SegmentDefs;
	DeleteFileSegment[cseg ! SwapError => CONTINUE];
	END;
    FrameDefs.RemoveGlobalFrame[frame];
    IF frame.alloced THEN
      BEGIN

      Align: PROCEDURE [POINTER, WORD] RETURNS [POINTER] =
	LOOPHOLE[InlineDefs.BITAND];
      IF frame.codelinks THEN FrameOps.Free[frame]
      ELSE FrameOps.Free[Align[frame - nlinks, 177774B]]
      END;
    END;

  CodeMatch: TYPE = {identical, same, different};

  SameCode: PROCEDURE [f1, f2: GlobalFrameHandle] RETURNS [cm: CodeMatch] =
    BEGIN
    o1, o2: BOOLEAN;
    seg1, seg2: SegmentDefs.FileSegmentHandle;
    fcb1, fcb2: ControlDefs.FrameCodeBase;
    seg1 _ FrameOps.CodeHandle[f1];
    seg2 _ FrameOps.CodeHandle[f2];
    fcb1 _ f1.code;
    fcb2 _ f2.code;
    IF seg1 = NIL AND seg2 = NIL THEN
      BEGIN
      fcb1.out _ fcb2.out _ FALSE;
      RETURN[IF fcb1 = fcb2 THEN identical ELSE different];
      END;
    IF seg1 # seg2 THEN RETURN[different];
    IF (o1 _ f1.code.out) AND (o2 _ f2.code.out) THEN
      RETURN[IF f1.code = f2.code THEN identical ELSE same];
    FrameDefs.SwapInCode[f1];
    FrameDefs.SwapInCode[f2];
    cm _ IF f1.code = f2.code THEN identical ELSE same;
    SegmentDefs.Unlock[seg1];
    SegmentDefs.Unlock[seg2];
    IF ~f1.started THEN f1.code _ fcb1;
    IF ~f2.started THEN f2.code _ fcb2;
    RETURN
    END;

  Init: PROCEDURE =
    BEGIN OPEN SDDefs;
    sd: POINTER TO ARRAY [0..0) OF UNSPECIFIED _ SD;
    sd[sCopy] _ Copy;
    sd[sUnNew] _ UnNewModule;
    END;

  -- Main Body;

  Init[];

  END...