-- File: LogDisplayCold.mesa
-- Roy Levin May 20, 1980 6:11 PM
-- Andrew Birrell 2-Jun-81 15:55:33
-- Mark Johnson May 29, 1981 11:48 AM
DIRECTORY
FontDefs USING [
CharHeight, CharWidth, CreateFont, FontHandle],
ImageDefs USING [
AddCleanupProcedure, BcdTime, CleanupItem, CleanupMask,
CleanupProcedure, RemoveCleanupProcedure],
InlineDefs USING[ LowHalf ],
LogDefs USING [
defaultRefreshInterval, defaultTypescriptLines, DisplayItem, noLimit,
Percentage],
LogPrivateDefs USING [
BitmapState, bmPointsPerLine, bmWordsPerLine, Cursor, cursorBM,
DCB, DCBchainHead, DCBHandle, DCBnil, dcbSeal, Displayer, Even, Face,
firstScriptDCB, firstScriptLineDCB, headingDCB, houses,
IllegalUseOfLog, interValueSeparatorWidth, intraValueSeparatorWidth,
italicSlant, lastScriptDCB, LogDisplayHot, machineFlavor, marginWords,
NumberHouseObject, PutStringInBitmap, ScreenPoints,
screenPointsPerWord, scriptFont, scriptBMStatePtr, scriptCurrentDCB,
spaceAfterHeading, spaceAfterStatus, startUpTime, statsFont, topMargin,
typescriptOn, uptimeHouse, Zero],
ProcessDefs USING [Abort, Seconds],
SegmentDefs USING [
BitmapDS, DataSegmentHandle, DefaultBase, DefaultBase1, DefaultPages,
DeleteDataSegment, DeleteFileSegment, FileHandle, FileSegmentHandle,
LongDataSegmentAddress, LongVMtoDataSegment, memConfig, NewFile,
NewDataSegment, NewFileSegment, OldFileOnly, Read],
StringDefs USING [AppendChar, AppendString],
Storage USING [Node, String, Free, FreeString],
TimeDefs USING [
AppendDayTime, AppendFullDayTime, CurrentDayTime, PackedTime,
UnpackDT];
LogDisplayCold: MONITOR
IMPORTS
FontDefs, ImageDefs, InlineDefs, LogPrivateDefs, ProcessDefs,
SegmentDefs, StringDefs, ShortTermHeap: Storage,
LongTermHeap: Storage, TimeDefs
EXPORTS LogDefs =
BEGIN OPEN FontDefs, LogDefs, LogPrivateDefs;
-- Types and Related Constants --
RegisteredValueObject: TYPE = --MACHINE DEPENDENT-- RECORD [
link: RegisteredValue,
item: DisplayItem,
textLine: [0..maxLines),
captionLeftX, numberLeftX: ScreenPoints,
caption: StringBody];
RegisteredValue: TYPE = POINTER TO RegisteredValueObject;
maxLines: CARDINAL = 100;
-- a (reasonable) upper bound of the number of displayed text lines
-- Global Variables --
firstValue, lastValue: RegisteredValue;
nValues: CARDINAL;
statisticsOn: BOOLEAN; -- typescriptOn in LogDisplayHot
statsPages: CARDINAL;
statsFontName: STRING;
statsFontFile: SegmentDefs.FileHandle;
statsFileSeg: SegmentDefs.FileSegmentHandle;
statsBMSegBase: LONG POINTER;
firstStatsDCB, lastStatsDCB, statusDCB, firstNumberDCB: DCBHandle;
nDCBs: CARDINAL;
statusString: STRING;
digitWidth, shortNumberWidth, longNumberWidth, percentageWidth: ScreenPoints;
displayProcess: PROCESS;
statsRefreshInterval: ProcessDefs.Seconds;
dcbChainHead: DCBHandle;
displayCleanup: ImageDefs.CleanupItem;
scriptPages: CARDINAL;
scriptLines: CARDINAL;
scriptFontName: STRING;
scriptFontFile: SegmentDefs.FileHandle;
scriptFileSeg: SegmentDefs.FileSegmentHandle;
scriptBMSegBase: LONG POINTER;
savedCursor: Cursor;
-- Miscellaneous Declarations --
noLimit: CARDINAL = LogDefs.noLimit;
daytimeLength: CARDINAL = 18; -- length of: 12-Jan-80 14:35:52
fullDaytimeLength: CARDINAL = 22; -- length of: 12-Jan-80 14:35:52 PST
elapsedTimeLength: CARDINAL = 13; -- length of: 1234567:35:28
-- Start/Stop Procedures --
StatisticsOn: PUBLIC ENTRY PROCEDURE [heading: STRING] =
-- called after all statistics specification procedures (SetStatisticsParameters and DisplayNumber) have been called. 'heading' is an ASCII string that will be displayed at the top of the screen. The 'heading' string need not persist in the client's storage after DisplayOn has returned. StatisticsOn concludes with an implicit ScreenOn.
BEGIN OPEN SegmentDefs;
statsBMWords: CARDINAL ← 0;
headingWords, statusWords: CARDINAL;
lineNumber: [0..maxLines) ← 0;
lineWidth: DESCRIPTOR FOR ARRAY [0..maxLines) OF CARDINAL ← DESCRIPTOR[
ShortTermHeap.Node[maxLines], maxLines];
lineHeight: ScreenPoints;
c: CHARACTER;
AssignPositionsForNumbers: PROCEDURE =
-- assigns positions for list of RegisteredValues, and computes the bitmap space required
-- to display them. It is assumed that at least one value can be placed before hitting the
-- client-imposed limit on bitmap space.
BEGIN
val, prevValue: RegisteredValue;
valWidth, numberWidth: ScreenPoints;
curX: ScreenPoints ← 0;
NewLine: PROCEDURE =
BEGIN
lineWidth[lineNumber] ←
IF curX = 0 THEN 0 ELSE EvenWords[curX - interValueSeparatorWidth];
statsBMWords ← lineWidth[lineNumber] + statsBMWords;
lineNumber ← lineNumber + 1;
curX ← 0;
END;
FOR val ← firstValue, val.link UNTIL val = NIL DO
numberWidth ←
SELECT val.item.format FROM
short => shortNumberWidth,
long => longNumberWidth,
ENDCASE => percentageWidth;
valWidth ←
ComputeStringWidth[@val.caption, statsFont, plain] +
intraValueSeparatorWidth + numberWidth;
IF (EvenWords[curX + valWidth] + statsBMWords)/256 = statsPages THEN
GO TO NoMore;
IF curX + valWidth >= bmPointsPerLine THEN NewLine[];
val.captionLeftX ← curX;
val.numberLeftX ← val.captionLeftX + valWidth - numberWidth;
val.textLine ← lineNumber;
curX ← curX + valWidth + interValueSeparatorWidth;
prevValue ← val;
REPEAT
NoMore =>
BEGIN
v: RegisteredValue;
lastValue ← prevValue;
UNTIL val = NIL DO
v ← val.link;
ShortTermHeap.Free[val];
val ← v;
nValues ← nValues - 1;
ENDLOOP;
NewLine[];
END;
FINISHED => NewLine[];
ENDLOOP;
END; -- AssignPositionsForNumbers
SetUpDCBsAndBitmap: PROCEDURE =
-- allocates the bitmap and initializes the DCBs.
BEGIN
dcb: DCBHandle;
bm: LONG POINTER;
bmSegSize: CARDINAL =
lineHeight*(headingWords + statusWords + statsBMWords);
bm ← statsBMSegBase ← AllocBitmap[bmSegSize];
firstStatsDCB ← dcb ← Even[LongTermHeap.Node[nDCBs*SIZE[DCB]+1]];
THROUGH [0..nDCBs) DO
dcb↑ ← DCB[
next: dcb + SIZE[DCB], resolution: high, background: white,
indenting: marginWords, width: 0,
height: lineHeight/2, longBitmap:];
dcb ← dcb.next;
ENDLOOP;
lastStatsDCB ← dcb - SIZE[DCB];
lastStatsDCB.next ← DCBnil;
-- set up initial spacer
firstStatsDCB.height ← topMargin/2;
-- set up heading
dcb ← headingDCB ← firstStatsDCB.next;
InitDCB[dcb, bm];
dcb.width ← headingWords;
dcb.indenting ← marginWords + (bmWordsPerLine - headingWords)/2;
bm ← bm + headingWords*lineHeight;
-- set up spacer after heading
dcb ← dcb.next;
dcb.height ← spaceAfterHeading;
-- set up status
dcb ← statusDCB ← dcb.next;
InitDCB[dcb, bm];
dcb.width ← statusWords;
dcb.indenting ← marginWords + (bmWordsPerLine - statusWords)/2;
bm ← bm + statusWords*lineHeight;
-- set up spacer after status
dcb ← dcb.next;
dcb.height ← spaceAfterStatus;
-- set up DCBs for statistics proper
dcb ← firstNumberDCB ← dcb.next;
FOR line: [0..maxLines) IN [0..lineNumber) DO
InitDCB[dcb, bm];
dcb.width ← lineWidth[line];
bm ← bm + lineWidth[line]*lineHeight;
dcb ← dcb.next;
ENDLOOP;
END; -- SetUpDCBsAndBitmap
BuildStatusString: PROCEDURE =
-- sets up the status string and variables required to refresh it.
BEGIN OPEN StringDefs, TimeDefs;
s1: STRING = "Version of "L;
s2: STRING = " Up at "L;
s3: STRING = " Uptime: "L;
length: CARDINAL =
s1.length + daytimeLength + s2.length + fullDaytimeLength + s3.length +
elapsedTimeLength;
startUpTime ← CurrentDayTime[];
statusString ← LongTermHeap.String[length];
AppendString[statusString, s1];
AppendDayTime[statusString, UnpackDT[ImageDefs.BcdTime[]]];
AppendString[statusString, s2];
AppendFullDayTime[statusString, UnpackDT[startUpTime]];
AppendString[statusString, s3];
uptimeHouse ← NumberHouseObject[
leftX: ComputeStringWidth[statusString, statsFont, plain],
width: elapsedTimeLength*digitWidth,
-- assumes CharWidth[':, statsFont]<digitWidth
dcb:, -- statusDCB not set up yet
caption: statusString, item:];
statusWords ← EvenWords[uptimeHouse.leftX + uptimeHouse.width];
END; -- BuildStatusString
BuildInitialScreen: PROCEDURE =
-- constructs the screen structures and fills in the bitmap with initial and constant quantities.
BEGIN
dcb: DCBHandle ← firstNumberDCB;
curLine: [0..maxLines) ← 0;
val: RegisteredValue;
bmState: BitmapState ← BitmapState[
origin: dcb.longBitmap, wordsPerLine: dcb.width, x:, y: 0];
h: CARDINAL;
houses ← DESCRIPTOR[
LongTermHeap.Node[nValues*SIZE[NumberHouseObject]], nValues];
FOR h IN [0..nValues) DO
IF firstValue.textLine ~= curLine THEN
BEGIN
curLine ← curLine + 1;
dcb ← dcb.next;
bmState.origin ← dcb.longBitmap;
bmState.wordsPerLine ← dcb.width;
END;
houses[h] ← NumberHouseObject[
leftX: firstValue.numberLeftX,
width:
SELECT firstValue.item.format FROM
short => shortNumberWidth,
long => longNumberWidth,
ENDCASE => percentageWidth, dcb: dcb,
caption: LongTermHeap.String[firstValue.caption.length],
item:];
StringDefs.AppendString[houses[h].caption, @(firstValue.caption)];
WITH val: firstValue.item SELECT FROM
short =>
houses[h].item ← short[
max: FIRST[CARDINAL], min: LAST[CARDINAL], p: val.p];
long =>
houses[h].item ← long[
max: FIRST[LONG CARDINAL], min: LAST[LONG CARDINAL], p: val.p];
percent =>
houses[h].item ← percent[
max: FIRST[Percentage], min: LAST[Percentage], p: val.p];
ENDCASE;
bmState.x ← firstValue.captionLeftX;
PutStringInBitmap[@firstValue.caption, statsFont, plain, @bmState];
val ← firstValue.link;
ShortTermHeap.Free[firstValue];
firstValue ← val;
ENDLOOP;
bmState ← BitmapState[
origin: headingDCB.longBitmap, wordsPerLine: headingDCB.width, x: 0, y: 0];
PutStringInBitmap[heading, statsFont, bold, @bmState];
bmState ← BitmapState[
origin: statusDCB.longBitmap, wordsPerLine: statusDCB.width, x: 0, y: 0];
PutStringInBitmap[statusString, statsFont, plain, @bmState];
uptimeHouse.dcb ← statusDCB;
END; -- BuildInitialScreen
IF statisticsOn THEN ERROR IllegalUseOfLog;
statsFontFile ← NewFile[
IF statsFontName = NIL THEN "SysFont.al"L ELSE statsFontName, Read,
OldFileOnly];
IF typescriptOn AND statsFontFile = scriptFontFile THEN
BEGIN statsFileSeg ← scriptFileSeg; statsFont ← scriptFont; END
ELSE
BEGIN
statsFileSeg ← NewFileSegment[
statsFontFile, DefaultBase, DefaultPages, Read];
statsFont ← CreateFont[statsFileSeg];
END;
[] ← statsFont.lock[statsFont];
IF statsFontName ~= NIL THEN ShortTermHeap.FreeString[statsFontName];
digitWidth ← 0;
FOR c IN ['0..'9] DO
digitWidth ← MAX[digitWidth, CharWidth[statsFont, c]]; ENDLOOP;
shortNumberWidth ← 5*digitWidth;
longNumberWidth ← 11*digitWidth;
percentageWidth ← 3*digitWidth + CharWidth[statsFont, '%];
AssignPositionsForNumbers[];
BuildStatusString[];
nDCBs ← lineNumber + 5; -- 5 = spacer, heading, spacer, status, spacer
headingWords ← EvenWords[ComputeStringWidth[heading, statsFont, bold]];
lineHeight ← CharHeight[statsFont, 'A];
SetUpDCBsAndBitmap[];
ShortTermHeap.Free[BASE[lineWidth]];
BuildInitialScreen[];
statisticsOn ← TRUE;
IF typescriptOn THEN lastStatsDCB.next ← firstScriptDCB
ELSE ImageDefs.AddCleanupProcedure[@displayCleanup];
dcbChainHead ← firstStatsDCB;
TurnScreenOn[];
savedCursor ← cursorBM↑;
displayProcess ← FORK Displayer[statsRefreshInterval];
END; --DisplayOn
TypescriptOn: PUBLIC ENTRY PROCEDURE =
-- called after the typescript specification procedure (SetTypescriptParameters) has been called. The typescript is initialized and made ready for calls on WriteChar, WriteString, and related output procedures. TypescriptOn concludes with an implicit ScreenOn.
BEGIN OPEN SegmentDefs;
bmWordsPerScriptLine: CARDINAL;
scriptSegSize: CARDINAL;
lineHeight: ScreenPoints;
SetUpDCBsAndBitmap: PROCEDURE =
-- allocates the bitmap and initializes the DCBs.
BEGIN
dcb: DCBHandle;
bm: LONG POINTER;
scriptBMSegBase ← AllocBitmap[scriptSegSize];
bm ← scriptBMSegBase - bmWordsPerScriptLine;
firstScriptDCB ← dcb ← Even[
LongTermHeap.Node[(scriptLines+1)*SIZE[DCB]+1]];
THROUGH [0..scriptLines + 1) DO
dcb↑ ← DCB[
next: dcb + SIZE[DCB], resolution: high, background: white,
indenting: marginWords, width: bmWordsPerLine,
height: lineHeight/2];
InitDCB[dcb, bm];
dcb ← dcb.next;
bm ← bm + bmWordsPerScriptLine;
ENDLOOP;
lastScriptDCB ← dcb - SIZE[DCB];
lastScriptDCB.next ← DCBnil;
firstScriptDCB.height ← topMargin/2;
firstScriptDCB.width ← 0;
firstScriptLineDCB ← scriptCurrentDCB ← firstScriptDCB.next;
scriptBMStatePtr↑ ← BitmapState[
origin: scriptCurrentDCB.longBitmap,
wordsPerLine: scriptCurrentDCB.width,
x: 0, y: 0];
END; -- SetUpDCBsAndBitmap
IF typescriptOn THEN ERROR IllegalUseOfLog;
scriptFontFile ← NewFile[
IF scriptFontName = NIL THEN "SysFont.al"L ELSE scriptFontName, Read,
OldFileOnly];
IF statisticsOn AND scriptFontFile = statsFontFile THEN
BEGIN scriptFileSeg ← statsFileSeg; scriptFont ← statsFont; END
ELSE
BEGIN
scriptFileSeg ← NewFileSegment[
scriptFontFile, DefaultBase, DefaultPages, Read];
scriptFont ← CreateFont[scriptFileSeg];
END;
[] ← scriptFont.lock[scriptFont];
IF scriptFontName ~= NIL THEN ShortTermHeap.FreeString[scriptFontName];
lineHeight ← CharHeight[scriptFont, 'A];
bmWordsPerScriptLine ← Even[lineHeight*bmWordsPerLine];
scriptSegSize ← (bmWordsPerScriptLine + SIZE[DCB])*scriptLines + SIZE[DCB];
IF Pages[scriptSegSize] > scriptPages THEN
BEGIN
scriptLines ← scriptPages*256/(bmWordsPerScriptLine + SIZE[DCB]);
scriptSegSize ← (bmWordsPerScriptLine + SIZE[DCB])*scriptLines + SIZE[DCB];
END;
SetUpDCBsAndBitmap[];
IF statisticsOn THEN lastStatsDCB.next ← firstScriptDCB
ELSE dcbChainHead ← firstScriptDCB;
typescriptOn ← TRUE;
IF ~statisticsOn THEN ImageDefs.AddCleanupProcedure[@displayCleanup];
TurnScreenOn[];
END; --TypescriptOn
DisplayOff: PUBLIC ENTRY PROCEDURE =
-- DisplayOff first performs an implicit ScreenOff, then causes an orderly cleanup of the display data structures. All information previously supplied via SetStatisticsParameters, DisplayNumber, and SetTypescriptParameters is discarded and all internal data structures are released.
BEGIN
TurnScreenOff[];
ImageDefs.RemoveCleanupProcedure[@displayCleanup];
IF statisticsOn THEN
BEGIN
ProcessDefs.Abort[displayProcess];
SegmentDefs.DeleteDataSegment[SegmentDefs.LongVMtoDataSegment[
statsBMSegBase]];
LongTermHeap.Free[firstStatsDCB];
LongTermHeap.Free[BASE[houses]];
statsFont.unlock[statsFont];
statsFont.destroy[statsFont];
SegmentDefs.DeleteFileSegment[statsFileSeg];
cursorBM↑ ← savedCursor;
END;
IF typescriptOn THEN
BEGIN
SegmentDefs.DeleteDataSegment[SegmentDefs.LongVMtoDataSegment[
scriptBMSegBase]];
LongTermHeap.Free[firstScriptDCB];
scriptFont.unlock[scriptFont];
IF ~(statisticsOn AND statsFontFile = scriptFontFile) THEN
BEGIN
scriptFont.destroy[scriptFont];
SegmentDefs.DeleteFileSegment[scriptFileSeg];
END;
END;
Initialize[];
END; --DisplayOff
ScreenOff: PUBLIC ENTRY PROCEDURE =
-- turns off the display screen without affecting any of the underlying data structures.
BEGIN TurnScreenOff[]; END; --ScreenOff
ScreenOn: PUBLIC ENTRY PROCEDURE =
-- undoes the effect of ScreenOff.
BEGIN TurnScreenOn[]; END; --ScreenOn
-- Statistics Display Procedures --
SetStatisticsParameters: PUBLIC ENTRY PROCEDURE [
bmPages: CARDINAL ← noLimit, font: STRING ← NIL,
refreshInterval: ProcessDefs.Seconds ← defaultRefreshInterval] =
-- This procedure alters the defaults for the statistics region of the display. 'bmPages' defines a limit on the number of bitmap pages to be allocated for statistics display. The actual number of pages allocated will depend of the number of DisplayItems registered via DisplayNumber. 'font', if not defaulted, specifies the name of a file to be used as the font for the statistics region (don't forget ".al"!); otherwise, "Sysfont.al" will be used. 'refreshInterval' is the time in seconds between updates of the statistics display. This procedure, if called at all, must be called before StatisticsOn.
BEGIN
IF statisticsOn THEN ERROR IllegalUseOfLog;
statsPages ← bmPages;
statsRefreshInterval ← refreshInterval;
IF font ~= NIL THEN
BEGIN
IF statsFontName ~= NIL THEN ShortTermHeap.FreeString[statsFontName];
statsFontName ← ShortTermHeap.String[font.length];
StringDefs.AppendString[statsFontName, font];
END;
END; --SetStatisticsParameters
DisplayNumber: PUBLIC ENTRY PROCEDURE [caption: STRING, item: DisplayItem] =
-- registers a value to be maintained on the display. 'item' defines the main memory location of the value (which must not change) and the format in which it is to be displayed. 'caption' is accompanying ASCII text. The 'caption' string need not persist in the client's storage after DisplayNumber has returned. DisplayNumber must be called before StatisticsOn.
BEGIN
value: RegisteredValue;
IF statisticsOn THEN ERROR IllegalUseOfLog;
value ← ShortTermHeap.Node[
SIZE[RegisteredValueObject] + (caption.length + 1 + 1)/2];
value↑ ←
[link: NIL, item: item, textLine:, captionLeftX:, numberLeftX:,
caption: [length: 0, maxlength: caption.length + 1, text:]];
StringDefs.AppendString[@value.caption, caption];
IF caption[caption.length - 1] ~= ': THEN
StringDefs.AppendChar[@value.caption, ':];
IF lastValue = NIL THEN firstValue ← value ELSE lastValue.link ← value;
lastValue ← value;
nValues ← nValues + 1;
END; --DisplayNumber
-- Typescript Procedures --
SetTypescriptParameters: PUBLIC ENTRY PROCEDURE [
tsPages: CARDINAL ← noLimit, tsLines: CARDINAL ← defaultTypescriptLines,
font: STRING ← NIL] =
-- This procedure alters the defaults for the typescript region ot the display. Up to 'tsLines' of text will be displayed, subject to the constraint that no more than 'tsPages' of bitmap will be consumed. 'font', if not defaulted, specifies the name of a file to be used as the font for the typescript region (don't forget ".al"!); otherwise, "Sysfont.al" will be used. This procedure, if called at all, must be called before TypescriptOn.
BEGIN
IF typescriptOn THEN ERROR IllegalUseOfLog;
scriptPages ← tsPages;
scriptLines ← tsLines;
IF font ~= NIL THEN
BEGIN
scriptFontName ← ShortTermHeap.String[font.length];
StringDefs.AppendString[scriptFontName, font];
END;
END; --SetTypescriptParameters
-- Internal Procedures --
AllocBitmap: PROC[words: CARDINAL] RETURNS[ptr: LONG POINTER] =
BEGIN OPEN SegmentDefs;
-- allocate and zero bitmap in appropriate part of machine --
seg: DataSegmentHandle = NewDataSegment[
IF machineFlavor = altoI THEN DefaultBase ELSE DefaultBase1,
Pages[words] ];
seg.type ← BitmapDS;
ptr ← LongDataSegmentAddress[seg];
Zero[ptr, words];
END;
InitDCB: PROC[dcb: DCBHandle, bitmap: LONG POINTER] =
BEGIN
-- arrange that DCB points to given bitmap, depending on machine --
-- ScreenOn sets bank register for Alto II's --
IF machineFlavor = dMachine
THEN { dcb.tag ← long; dcb.shortBitmap ← dcbSeal }
ELSE { dcb.tag ← short; dcb.shortBitmap ← InlineDefs.LowHalf[bitmap] };
dcb.longBitmap ← bitmap;
END;
ComputeStringWidth: PROCEDURE [s: STRING, font: FontHandle, face: Face]
RETURNS [width: ScreenPoints] =
-- computes the width in ScreenPoints of the string 's' presented in 'font' and 'face'.
BEGIN
i: CARDINAL;
width ←
SELECT face FROM
plain => 0,
bold => s.length,
ENDCASE => CharHeight[font, 'A]/italicSlant - 1;
FOR i IN [0..s.length) DO width ← CharWidth[font, s[i]] + width; ENDLOOP;
END; --ComputeStringWidth
EvenWords: PROCEDURE [points: ScreenPoints] RETURNS [CARDINAL] =
-- rounds up the argument number of screen points to an even number of words.
BEGIN
RETURN[Even[(points + screenPointsPerWord - 1)/screenPointsPerWord]]
END; --EvenWords
Pages: PROCEDURE [words: CARDINAL] RETURNS [CARDINAL] =
-- rounds up the argument number of words to a count of pages.
BEGIN RETURN[(words + 255)/256] END; --EvenWords
DisplayCleanup: ImageDefs.CleanupProcedure =
-- deals with the display at appropriate entry/exit. Note: in principle, this should be an ENTRY procedure, but that can cause deadlocks when debugging. Since this procedure isn't called in normal operation, we ignore the problem.
BEGIN
SELECT why FROM
Finish, Abort, OutLd => TurnScreenOff[];
InLd => TurnScreenOn[];
ENDCASE;
END; --DisplayCleanup
BankReg: TYPE = MACHINE DEPENDENT RECORD[
spare: [0..7777B], normal: [0..3], alt: [0..3] ];
dwtBankReg: POINTER TO BankReg = LOOPHOLE[177740B+11B];
bitmapBank: [0..3] = 1; -- defined by use of DefaultBase1 in AllocBitmap
TurnScreenOff: PROCEDURE =
BEGIN
-- Note: we busy wait instead of WAITing because Mesa insists on disabling scheduling
-- during Finish and Abort (ugh), and ScreenOff is called from DisplayCleanup.
realTime: POINTER TO CARDINAL = LOOPHOLE[430B];
delayStart: CARDINAL = realTime↑;
DCBchainHead↑ ← DCBnil;
UNTIL realTime↑ - delayStart > 2 DO ENDLOOP;
SELECT machineFlavor FROM
xmesa39, altoMesa => dwtBankReg.normal ← 0;
ENDCASE => NULL;
END; --TurnScreenOff
TurnScreenOn: PROCEDURE =
-- undoes the effect of ScreenOff.
BEGIN
SELECT machineFlavor FROM
xmesa39, altoMesa => dwtBankReg.normal ← bitmapBank;
ENDCASE => NULL;
DCBchainHead↑ ← dcbChainHead;
END; --TurnScreenOn
-- Initialization --
Initialize: PROCEDURE =
-- initializes all global variables. No initialization should occur in the variable declarations, since Initialize must restore the complete initial state of the global variables and is called from two places (the main body and DisplayOff).
BEGIN OPEN ImageDefs;
machineFlavor ← SELECT SegmentDefs.memConfig.AltoType FROM
AltoIIXM => SELECT SegmentDefs.memConfig.mesaMicrocodeVersion FROM
39 => xmesa39,
41 => altoMesa,
ENDCASE => altoI,
Dorado, D0 => dMachine,
ENDCASE => altoI;
firstValue ← lastValue ← NIL;
nValues ← 0;
statisticsOn ← typescriptOn ← FALSE;
statsPages ← noLimit;
statsFontName ← NIL;
scriptPages ← noLimit;
scriptLines ← defaultTypescriptLines;
scriptFontName ← NIL;
statsRefreshInterval ← defaultRefreshInterval;
dcbChainHead ← DCBnil;
displayCleanup ←
[link:,
mask:
CleanupMask[Finish] + CleanupMask[Abort] + CleanupMask[OutLd] +
CleanupMask[InLd], proc: DisplayCleanup];
END; --Initialize
-- Main Body --
START LogDisplayHot;
Initialize[];
END.