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