-- run configuration subroutine for command interpreter part of
-- silicon (pretty picture) program
-- modified by E. McCreight, December 31, 1982 1:32 PM
DIRECTORY
BcdDefs,
BcdOps,
ChipUserInt,
ControlDefs,
DiskKDDefs,
FrameDefs,
FrameOps,
LoaderOps,
MiscDefs,
ppdefs,
ppMainDefs,
ProcessDefs,
ProcessOps,
PSBDefs,
SegmentDefs,
Storage,
StreamDefs,
StringDefs,
SwapperOps,
TrapDefs;
ppRunConfig: PROGRAM
IMPORTS ChipUserInt, DiskKDDefs, FrameDefs, FrameOps,
LoaderOps, ppdefs,
SegmentDefs, Storage, StreamDefs, StringDefs, SwapperOps
EXPORTS ppMainDefs
SHARES SegmentDefs = PUBLIC
BEGIN
OPEN ppdefs, StringDefs, ChipUserInt, ppMainDefs;
SubrList: TYPE = RECORD[next: SubrListPtr, name: STRING];
SubrListPtr: TYPE = POINTER TO SubrList;
runningSubrs: SubrListPtr ← NIL;
doRunConfig: cmdProc =
BEGIN
otherSubr: SubrListPtr;
subr: SubrList ← [next: runningSubrs, name: NIL];
BEGIN ENABLE Punt, UNWIND => GOTO Finished;
subr.name ← FixExtension[
RequestString["Type subroutine name:"L, "Must be .chipbcd file"L], ".chipbcd"];
FOR otherSubr ← runningSubrs, otherSubr.next WHILE otherSubr#NIL DO
IF StringDefs.EquivalentString[subr.name, otherSubr.name] THEN
BEGIN
Explain["I can't run two copies of that subroutine at once!"];
GOTO Finished;
END;
ENDLOOP;
IF runningSubrs#NIL THEN
BEGIN
comment: STRING ← [150];
comment.length ← 0;
StringDefs.AppendString[to: comment, from: "I am already running "];
FOR otherSubr ← runningSubrs, otherSubr.next WHILE otherSubr#NIL DO
StringDefs.AppendString[to: comment, from: otherSubr.name];
StringDefs.AppendString[to: comment, from: ", "];
ENDLOOP;
StringDefs.AppendString[to: comment, from: "OK?"];
IF NOT HeSaysYes[comment] THEN GOTO Finished;
END;
IF LocalizeBcd[subr.name] THEN
BEGIN
p: PROCESS;
runningSubrs ← @subr;
p ← FORK DoRunBcd[subr.name];
JOIN p;
END;
refreshTypeInScreen[];
GOTO Finished;
EXITS
Finished =>
BEGIN
IF subr.name#NIL THEN FreeString[subr.name];
runningSubrs ← subr.next;
END;
END;
END;
LocalizeBcd: PROCEDURE[s: STRING] RETURNS[worked: BOOLEAN] =
BEGIN
file: StreamDefs.StreamHandle;
worked ← FALSE;
file ← StreamDefs.NewWordStream[
name: s, access: StreamDefs.Read
! SegmentDefs.FileNameError => GOTO Missing];
file.destroy[file];
worked ← TRUE
EXITS
Missing => Explain["Can't find file"L, s];
END; -- of LocalizeBcd
DoRunBcd: PROCEDURE [bcdname: STRING] =
BEGIN
OPEN StringDefs;
VitalSigns: TYPE = RECORD [processes, modules, pages: CARDINAL];
GetVitalSigns: PROCEDURE RETURNS [vitalSigns: VitalSigns] =
BEGIN
OPEN ProcessOps, SegmentDefs;
CheckSegment: PROCEDURE [seg: SegmentHandle] RETURNS [BOOLEAN] =
BEGIN
inc: CARDINAL ← 0;
WITH s: seg SELECT FROM
data =>
SELECT s.type FROM
IN [FrameDS .. BitmapDS] => NULL;
ENDCASE => inc ← s.pages;
file =>
-- deal with AltoLoader bug that doesn't flush code after errors
-- only works for single file bcds
IF s.file = runFile AND s.class = code AND s.lock = 0 THEN
DeleteFileSegment[@s]
ELSE IF s.lock > 0 THEN inc ← s.pages;
ENDCASE;
vitalSigns.pages ← vitalSigns.pages + inc;
RETURN[FALSE]
END; -- of CheckSegment --
CountModule: PROCEDURE [f: ControlDefs.GlobalFrameHandle] RETURNS [BOOLEAN] =
BEGIN
vitalSigns.modules ← vitalSigns.modules + 1;
RETURN[FALSE]
END; -- of CountModule --
vitalSigns ← [0, 0, 0];
-- FOR p: PSBDefs.ProcessHandle ← FirstProcess↑, p + SIZE[PSBDefs.PSB] DO
-- IF p.state = alive THEN vitalSigns.processes ← vitalSigns.processes + 1;
-- IF p = LastProcess↑ THEN EXIT;
-- ENDLOOP;
[] ← DiskKDDefs.CloseDiskKD[];
[] ← SwapperOps.EnumerateObjects[segment, LOOPHOLE[CheckSegment]];
-- [] ← FrameDefs.EnumerateGlobalFrames[CountModule];
END; -- of GetVitalSigns
RunBcd: PROCEDURE =
BEGIN
OPEN FrameDefs, LoaderOps, SegmentDefs;
cm: ControlDefs.ControlModule;
bcd: BcdOps.BcdBase;
bcdseg: FileSegmentHandle;
OurLoad: PROCEDURE RETURNS [worked: BOOLEAN] =
-- This is derived from AltoLoader.Load and incorporates some bug fixes
-- and some optimizations.
BEGIN
bcdseg ← NewFileSegment[runFile, 1, 1, Read];
BEGIN
pages: CARDINAL;
worked ← FALSE;
MakeSwappedIn[bcdseg, DefaultMDSBase, HardUp ! SegmentFault => GO TO bogus];
bcd ← FileSegmentAddress[bcdseg];
IF bcd.versionIdent # BcdDefs.VersionID OR bcd.definitions THEN
{Unlock[bcdseg]; GO TO bogus}
ELSE IF (pages ← bcd.nPages) > 1 THEN
BEGIN
Unlock[bcdseg];
MoveFileSegment[bcdseg, 1, pages];
MakeSwappedIn[bcdseg, DefaultMDSBase, HardUp];
bcd ← FileSegmentAddress[bcdseg];
END;
worked ← TRUE;
EXITS
bogus => DeleteFileSegment[bcdseg];
END;
END; -- of OurLoad --
OurUnload: PROCEDURE =
BEGIN
Unlock[bcdseg];
DeleteFileSegment[bcdseg];
END; -- of OurUnload --
BEGIN ENABLE Punt => GOTO out;
runFile ← NewFile[s, Read, OldFileOnly
! FileNameError => {Explain["File not found"L]; GO TO out}];
LockFile[runFile];
IF ~OurLoad[ ! InsufficientVM => {Explain["Program too large"L]; GO TO out}]
THEN GO TO cantExecute;
cm ← LoaderOps.New[bcd, TRUE, FALSE
! BadCode => GO TO cantExecute;
StringDefs.StringBoundsFault =>
{Explain["Unexpected string bounds fault"L]; GO TO out};
VersionMismatch => {Explain["Interface versions don't match", name]; GO TO out};
FileNotFound =>
{Explain["Code-containing subordinate .bcd missing", name]; GO TO out};
InsufficientVM =>
{Explain["Insufficient VM -- suggest restart"L]; OurUnload[]; GO TO out}
];
IF cm = ControlDefs.NullControl THEN GO TO cantExecute;
END;
FrameOps.Start[cm ! UNWIND => UnNewConfig[cm.frame]];
UnNewConfig[cm.frame];
EXITS
cantExecute => Explain["File doesn't look like kosher code"L ! Punt => CONTINUE];
out => NULL;
END; -- of RunBcd --
s: STRING ← [100];
originalVitalSigns, newVitalSigns: VitalSigns;
runFile: SegmentDefs.FileHandle ← NIL;
AppendString[s, bcdname];
[] ← Storage.Prune[];
originalVitalSigns ← GetVitalSigns[];
RunBcd[ ! Punt -- quit from user -- , ABORTED -- Quit from debugger -- => CONTINUE];
newVitalSigns ← GetVitalSigns[];
IF newVitalSigns.modules ~= originalVitalSigns.modules
OR newVitalSigns.pages ~= originalVitalSigns.pages
-- OR newVitalSigns.processes # originalVitalSigns.processes --
-- OR clientWords # 0 --
-- OR clientPages # 0 -- THEN
BEGIN
-- IF newVitalSigns.processes > originalVitalSigns.processes+2 THEN
-- Explain["Warning: Processes left over"L ! Punt => CONTINUE];
IF newVitalSigns.modules ~= originalVitalSigns.modules THEN
Explain["Warning: Modules left over"L ! Punt => CONTINUE];
-- IF newVitalSigns.pages ~= originalVitalSigns.pages THEN
-- Explain["Warning: Pages left over"L ! Punt => CONTINUE];
-- IF clientPages # 0 OR clientWords # 0 THEN
-- Explain["Warning: Subroutine dynamic storage left over"L ! Punt => CONTINUE];
END;
IF runFile ~= NIL THEN
{SegmentDefs.UnlockFile[runFile]; SegmentDefs.ReleaseFile[runFile]};
END; -- of DoRunBcd --
END.