-- Miscellaneous.mesa; edited by Sandman, September 2, 1980  10:04 AM
-- Copyright  Xerox Corporation 1979, 1980

DIRECTORY
  AltoFileDefs USING [TIME],
  BcdDefs USING [NullVersion, VersionID, VersionStamp],
  BitBltDefs USING [AlignedBBTable, BBptr, BBTableSpace, BITBLT],
  ControlDefs USING [
    ControlLink, FrameHandle, GFT, GFTIndex, GlobalFrameHandle, NullEpBase,
    NullGlobalFrame, NullLink, UnboundLink],
  FrameDefs USING [GlobalFrame, SwapInCode, SwapOutCode, UnNew],
  FrameOps USING [CodeHandle, Free, GetReturnFrame, ReleaseCode, SetReturnLink],
  ImageDefs USING [
    AbortMesa, CleanupItem, CleanupMask, CleanupProcedure, StopMesa],
  ImageFormat USING [ImageHeader, VersionID],
  InlineDefs USING [BITAND, COPY, LongNumber],
  MiscDefs USING [DAYTIME],
  NucleusOps USING [Resident],
  ProcessDefs USING [DisableInterrupts, EnableInterrupts],
  Runtime USING [],
  SDDefs USING [SD, sGoingAway],
  SDOps USING [BlockEqualLong, ByteBlockEqualLong, Signal],
  SegmentDefs USING [
    DefaultANYBase, DeleteFileSegment, FileSegmentAddress, FileSegmentHandle,
    MakeSwappedIn, MoveFileSegment, NewFileSegment, Read, SwapIn, Unlock],
  SwapperOps USING [SwapOutCodeSeg],
  SystemDefs USING [],
  TrapDefs USING [ResumeError];

Miscellaneous: PROGRAM
  IMPORTS
    BitBltDefs, FrameDefs, FrameOps, ImageDefs, InlineDefs, MiscDefs, NucleusOps,
    ProcessDefs, SDOps, SegmentDefs, SwapperOps, TrapDefs
  EXPORTS FrameDefs, ImageDefs, MiscDefs, NucleusOps, Runtime, SDOps, SystemDefs
  SHARES ControlDefs =PUBLIC

  BEGIN OPEN ControlDefs;

  DeletedFrame: PROCEDURE [gfi: GFTIndex] RETURNS [BOOLEAN] =
    BEGIN RETURN[GFT[gfi] = [frame: NullGlobalFrame, epbase: NullEpBase]]; END;

  SwapOutCode: PROCEDURE [f: GlobalFrameHandle] =
    BEGIN
    cseg: SegmentDefs.FileSegmentHandle = FrameOps.CodeHandle[f];
    IF cseg # NIL THEN SwapperOps.SwapOutCodeSeg[cseg];
    RETURN
    END;

  LockCode: PROCEDURE [link: UNSPECIFIED] =
    BEGIN FrameDefs.SwapInCode[FrameDefs.GlobalFrame[link]]; RETURN END;

  UnlockCode: PROCEDURE [link: UNSPECIFIED] =
    BEGIN OPEN FrameDefs;
    seg: SegmentDefs.FileSegmentHandle _ FrameOps.CodeHandle[GlobalFrame[link]];
    IF seg # NIL AND seg.lock # 0 THEN SegmentDefs.Unlock[seg];
    RETURN
    END;

  MakeCodeResident: PROCEDURE [f: GlobalFrameHandle] =
    BEGIN OPEN SegmentDefs;
    seg: FileSegmentHandle;
    IF (seg _ FrameOps.CodeHandle[f]) = NIL THEN RETURN;
    IF seg.lock = 0 THEN FrameDefs.SwapOutCode[f];
    MakeSwappedIn[seg, DefaultANYBase, [hard, bottomup, code]];
    RETURN
    END;

  GetCaller: PROCEDURE RETURNS [PROGRAM] =
    BEGIN
    RETURN[LOOPHOLE[FrameOps.GetReturnFrame[].returnlink.frame.accesslink]];
    END;

  IsBound: PROCEDURE [link: UNSPECIFIED] RETURNS [BOOLEAN] =
    BEGIN
    RETURN[link # ControlDefs.UnboundLink AND link # ControlDefs.NullLink];
    END;

  SelfDestruct: PROCEDURE =
    BEGIN
    destructee: FrameHandle _ FrameOps.GetReturnFrame[];
    FrameOps.SetReturnLink[destructee.returnlink];
    FrameDefs.UnNew[FrameDefs.GlobalFrame[destructee]];
    FrameOps.Free[destructee];
    RETURN
    END;

  -- Bcd Version and Time


  Version: PROCEDURE [frame: GlobalFrameHandle, type: {bcd, image}]
    RETURNS [version: BcdDefs.VersionStamp] =
    BEGIN OPEN SegmentDefs;
    codeseg: FileSegmentHandle _ FrameOps.CodeHandle[frame];
    seg: FileSegmentHandle;
    image: POINTER TO ImageFormat.ImageHeader;
    id: CARDINAL;
    p: POINTER TO RECORD [a, pages: CARDINAL];
    IF codeseg = NIL THEN RETURN[BcdDefs.NullVersion];
    seg _ NewFileSegment[codeseg.file, 1, 1, Read];
    SwapIn[seg];
    image _ p _ FileSegmentAddress[seg];
    IF type = image AND image.prefix.versionident # ImageFormat.VersionID THEN
      BEGIN
      base: CARDINAL _ p.pages + 1;
      Unlock[seg];
      MoveFileSegment[seg, base, 1];
      SwapIn[seg];
      image _ FileSegmentAddress[seg];
      END;
    id _ image.prefix.versionident;
    version _
      IF (id = ImageFormat.VersionID) OR (type = bcd AND id = BcdDefs.VersionID)
      THEN image.prefix.version ELSE BcdDefs.NullVersion;
    Unlock[seg];
    DeleteFileSegment[seg];
    RETURN
    END;

  BcdVersion: PROCEDURE RETURNS [version: BcdDefs.VersionStamp] =
    BEGIN OPEN FrameDefs, FrameOps;
    RETURN[Version[frame: GlobalFrame[GetReturnFrame[]], type: bcd]]
    END;

  GetBcdTime, BcdTime: PROCEDURE RETURNS [LONG CARDINAL] = {
    OPEN FrameDefs, FrameOps;
    RETURN[Version[frame: GlobalFrame[GetReturnFrame[]], type: bcd].time]};

  -- Image Version and Time


  ImageVersion: PROCEDURE RETURNS [version: BcdDefs.VersionStamp] =
    BEGIN OPEN FrameDefs;
    RETURN[Version[frame: GlobalFrame[NucleusOps.Resident], type: image]]
    END;

  GetBuildTime, ImageTime: PROCEDURE RETURNS [LONG CARDINAL] = {
    OPEN FrameDefs;
    RETURN[Version[frame: GlobalFrame[NucleusOps.Resident], type: image].time]};

  CurrentTime: PROCEDURE RETURNS [LONG CARDINAL] =
    BEGIN
    time: AltoFileDefs.TIME _ MiscDefs.DAYTIME[];
    RETURN[
      LOOPHOLE[InlineDefs.LongNumber[
	num[highbits: time.high, lowbits: time.low]]]];
    END;

  Even: PROCEDURE [n: CARDINAL] RETURNS [CARDINAL] = {RETURN[n + (n MOD 2)]};

  Quad: PROCEDURE [n: CARDINAL] RETURNS [CARDINAL] = {
    RETURN[n + InlineDefs.BITAND[-n, 3B]]};

  SetBlock: PROCEDURE [p: POINTER, v: UNSPECIFIED, l: CARDINAL] =
    BEGIN
    IF l = 0 THEN RETURN;
    p^ _ v;
    InlineDefs.COPY[from: p, to: p + 1, nwords: l - 1];
    RETURN
    END;

  PPA: TYPE = POINTER TO PACKED ARRAY [0..0) OF [0..377B];

  BlockEqualCodeLong: PUBLIC PROCEDURE [
    p1: LONG POINTER, n: CARDINAL, offset: CARDINAL] RETURNS [BOOLEAN] =
    BEGIN
    result: BOOLEAN;
    p2: LONG POINTER;
    frame: GlobalFrameHandle = FrameOps.GetReturnFrame[].accesslink;
    FrameDefs.SwapInCode[frame];
    p2 _
      IF frame.code.highByte = 0 THEN frame.code.longbase + offset
      ELSE frame.code.shortbase + offset;
    result _ SDOps.BlockEqualLong[p1: p1, n: n, p2: p2];
    FrameOps.ReleaseCode[frame];
    RETURN[result]
    END;

  ByteBlockEqualCodeLong: PUBLIC PROCEDURE [
    p1: LONG POINTER, n: CARDINAL, offset: CARDINAL] RETURNS [BOOLEAN] =
    BEGIN
    result: BOOLEAN;
    p2: LONG POINTER;
    frame: GlobalFrameHandle = FrameOps.GetReturnFrame[].accesslink;
    FrameDefs.SwapInCode[frame];
    p2 _
      IF frame.code.highByte = 0 THEN frame.code.longbase + offset
      ELSE frame.code.shortbase + offset;
    result _ SDOps.ByteBlockEqualLong[p1: p1, n: n, p2: p2];
    FrameOps.ReleaseCode[frame];
    RETURN[result]
    END;

  ByteBlt: PUBLIC PROCEDURE [to, from: PPA, toByte, fromByte, nBytes: CARDINAL] =
    BEGIN
    IF nBytes = 0 THEN RETURN;
    IF (toByte MOD 2) # 0 THEN
      BEGIN
      to[toByte] _ from[fromByte];
      toByte _ toByte + 1;
      fromByte _ fromByte + 1;
      nBytes _ nBytes - 1;
      END;
    IF (fromByte MOD 2) = 0 THEN -- fast case: both are word aligned
      BEGIN
      words: CARDINAL = nBytes/2;
      InlineDefs.COPY[to: to + toByte/2, from: from + fromByte/2, nwords: words];
      IF 2*words # nBytes THEN to[toByte + 2*words] _ from[fromByte + 2*words];
      -- move the last byte

      END
    ELSE -- slow case: have to ripple things
      BEGIN
      lineWidth: CARDINAL = 16; -- words per line: controls interrupt latency
      bba: BitBltDefs.BBTableSpace;
      bbt: BitBltDefs.BBptr _ BitBltDefs.AlignedBBTable[@bba];
      lines, tail: CARDINAL;
      bbt^ _
	[sourcetype: block, function: replace, dbca: to + toByte/2,
	  dbmr: lineWidth, dlx: 0, dw: 16*lineWidth, sbca: from + fromByte/2,
	  sbmr: lineWidth, slx: 8];
      -- BITBLT is not interruptable except at the end of each scan line,
      -- so we break things up into chunks in order to maintain reasonable
      -- interrupt latency for the IO devices.  It takes about 200microsec
      -- to move 50 bytes with the display off.
      tail _ nBytes MOD (2*lineWidth); -- bytes left to move with second BitBlt
      lines _ nBytes/(2*lineWidth);
      -- This "moves" a rectangle that is lineWidth words wide by as many
      -- lines high as will fit.  NB: It cheats and actually reads a byte
      -- from beyond the edge of the rectangle.  This is not really legal,
      -- but works out OK for any reasonable inplementation of BitBlt.
      bbt.dty _ bbt.sty _ 0;
      bbt.dw _ 16*lineWidth;
      bbt.dh _ lines;
      BitBltDefs.BITBLT[bbt];
      -- This BitBlt will move one line that is less than lineWidth words wide.
      bbt.dty _ bbt.sty _ lines;
      bbt.dw _ 8*tail;
      bbt.dh _ 1;
      BitBltDefs.BITBLT[bbt];
      END;
    END;

  -- procedure lists

  UserCleanupList: POINTER TO ImageDefs.CleanupItem _ NIL;

  AddCleanupProcedure: PROCEDURE [item: POINTER TO ImageDefs.CleanupItem] =
    BEGIN
    ProcessDefs.DisableInterrupts[];
    RemoveCleanupProcedure[item];
    item.link _ UserCleanupList;
    UserCleanupList _ item;
    ProcessDefs.EnableInterrupts[];
    END;

  RemoveCleanupProcedure: PROCEDURE [item: POINTER TO ImageDefs.CleanupItem] =
    BEGIN
    prev, this: POINTER TO ImageDefs.CleanupItem;
    IF UserCleanupList = NIL THEN RETURN;
    ProcessDefs.DisableInterrupts[];
    prev _ this _ UserCleanupList;
    IF this = item THEN UserCleanupList _ this.link
    ELSE
      UNTIL (this _ this.link) = NIL DO
	IF this = item THEN BEGIN prev.link _ this.link; EXIT END;
	prev _ this;
	ENDLOOP;
    ProcessDefs.EnableInterrupts[];
    END;

  UserCleanupProc: ImageDefs.CleanupProcedure =
    BEGIN -- all interrupts off if why = finish or abort
    this, next: POINTER TO ImageDefs.CleanupItem;
    this _ UserCleanupList;
    UserCleanupList _ NIL;
    WHILE this # NIL DO
      next _ this.link;
      IF InlineDefs.BITAND[ImageDefs.CleanupMask[why], this.mask] # 0 THEN
	this.proc[why ! ANY => IF why = Abort OR why = Finish THEN CONTINUE];
      AddCleanupProcedure[this];
      this _ next;
      ENDLOOP;
    SELECT why FROM
      Finish => ImageDefs.StopMesa[];
      Abort => ImageDefs.AbortMesa[];
      ENDCASE;
    END;

  --  Signaller Overflow routines; known not to be called in resident stuff


  ReturnError: PROCEDURE [signal: SIGNAL, message: UNSPECIFIED] =
    BEGIN
    caller: FrameHandle = FrameOps.GetReturnFrame[];
    FrameOps.SetReturnLink[caller.returnlink];
    SDOps.Signal[signal, message ! UNWIND => FrameOps.Free[caller]];
    FrameOps.Free[caller];
    ERROR TrapDefs.ResumeError
    END;

  ReturnErrorList: PROCEDURE [signal: SIGNAL, message: POINTER TO UNSPECIFIED] =
    BEGIN
    caller: FrameHandle = FrameOps.GetReturnFrame[];
    FrameOps.SetReturnLink[caller.returnlink];
    SDOps.Signal[
      signal, message !
      UNWIND => BEGIN FrameOps.Free[caller]; FrameOps.Free[message]; END];
    FrameOps.Free[caller];
    FrameOps.Free[message];
    ERROR TrapDefs.ResumeError
    END;

  -- Main Body;

  SDDefs.SD[SDDefs.sGoingAway] _ UserCleanupProc;

  END...