-- 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...