-- File: ExecSS.mesa
-- edited by Levin,  November 2, 1981  2:27 PM.
-- edited by Brotz, October 12, 1982  10:54 AM.
-- edited by Schroeder, February 6, 1981  2:49 PM.
-- edited by Taft, May 13, 1983  10:23 AM

DIRECTORY
  AltoFileDefs USING [FilenameChars],
  Ascii USING [LF],
  BcdDefs USING [VersionID],
  BcdOps USING [BcdBase],
  ControlDefs USING [ControlModule, GlobalFrameHandle, NullControl],
  Core USING [Close, Open],
  displayCommon USING [bitmapInMDS],
  Editor USING [DeUnderlineSelection, InitializeSelection, insertDeletionCode,
    MakeCharIndexVisible, RefreshEndOfMessage, RefreshSoThatFirstCharStartsLine,
    ResetBuffers, SwapMessageWithDeletionBuffer],
  exD: FROM "ExceptionDefs" USING [AppendExceptionString, AppendStringToExceptionLine,
    bcdUnexecutable, ClearExceptionsRegion, DisplayExceptionLine,
    DisplayExceptionStringOnLine, Exception, ExceptionLineOverflow, fileNotFound,
    FlashExceptionsRegion, illegalBrackets, nil, programTooLarge, remoteFileWillOverwrite,
    requiredFileMissing, retrievingRemoteFile, runCanceled, suggestRestart, SysBug,
    SysBugSignal, versionMismatch],
  FrameDefs USING [UnNewConfig],
  FrameOps USING [Start],
  inD: FROM "InteractorDefs" USING [CaretIsBlinking, CharIndex, Confirm, ConfirmBrackets,
    HousePtr, IndicateCommandFinished, LinePtr, MakeCommandsCallable,
    maxBracketStringLength, SetCaretBlinking, StopBlinkingCaret, TextSelection,
    TextSelectionPtr],
  intCommon USING [actionPoint, answerCommandHouse, cmTextNbr, commandMode,
    commandType, composedMessageEdited, copyCommandHouse, deleteCommandHouse,
    deliverCommandHouse, displayCommandHouse, editorType, forwardCommandHouse,
    getCommandHouse, hardcopyCommandHouse, keystream, mailFileCommandHouse,
    moveToCommandHouse, newFormCommandHouse, newMailCommandHouse,
    putCommandHouse, quitCommandHouse, runBracketsHouse, runCommandHouse,
    runCommandMode, runPath, target, undeleteCommandHouse, userCommandHouse],
  IODefs USING [SetInputStream, SetOutputStream],
  KeyDefs USING [ChangeKey],
  LaurelBitmapDefs USING [SetBitmapNotifyProc],
  LaurelExecDefs USING [MenuCommand],
  LaurelExecImpDefs USING [ClearCharDS, ClearCurrentLineDS, ClearLineDS, clientWords,
    cmMnp, DestroyDS, DestroyKS, EndOfDS, EndOfKS, FinalizeExecIO, FinishExecStorage,
    GetDS, GetKS, InitializeExecIO, PutBackDS, PutBackKS, PutDS, PutKS, ResetDS,
    ResetKS, StartExecStorage],
  lmD: FROM "LaurelMenuDefs" USING [ChangeEditorMenu],
  LoaderOps USING [BadCode, FileNotFound, New, VersionMismatch],
  opD: FROM "OperationsDefs" USING [Copy, FileError],
  prD: FROM "ProtectionDefs" USING [UnprotectAllFields],
  ProcessDefs USING [Detach],
  SegmentDefs USING [DefaultMDSBase, DeleteFileSegment, FileHandle, FileNameError,
    FileSegmentAddress, FileSegmentHandle, HardUp, InsufficientVM, LockFile,
    MakeSwappedIn, MoveFileSegment, NewFile, NewFileSegment, OldFileOnly, Read,
    ReleaseFile, SegmentFault, SegmentHandle, Unlock, UnlockFile],
  Storage USING [Free, Node, Prune, StringLength],
  StreamDefs USING [DisplayHandle, KeyboardHandle, StreamHandle, StreamObject],
  String USING [AppendOctal, AppendString, AppendSubString, EquivalentString,
    EquivalentSubString, StringBoundsFault, SubStringDescriptor],
  SwapperOps USING [EnumerateObjects],
  TrapDefs USING [SendMsgSignal],
  vmD: FROM "VirtualMgrDefs" USING [CharIndex, CMOCharMapTable, ComposedMessage,
    ComposedMessagePtr, DeleteRangeInMessage, GetMessageSize, InvalidateCaches,
    PageNumber],
  VMDefs USING [CantOpen, FileHandle];

ExecSS: PROGRAM
  IMPORTS Core, disC: displayCommon, Editor, exD, FrameDefs, FrameOps, inD,
    intC: intCommon, IODefs, KeyDefs, LaurelBitmapDefs, LaurelExecImpDefs, lmD,
    LoaderOps, opD, prD, ProcessDefs, SegmentDefs, Storage, String, SwapperOps,
    TrapDefs, vmD, VMDefs
  EXPORTS inD, LaurelExecDefs, LaurelExecImpDefs, StreamDefs
  SHARES SegmentDefs, StreamDefs =

BEGIN
OPEN LaurelExecImpDefs;


RunCommand: PUBLIC PROCEDURE [hp: inD.HousePtr, confirmed: BOOLEAN] =
BEGIN
OPEN inD;
bcdname: STRING _ [maxBracketStringLength];

cmMnp _ intC.cmTextNbr;
inD.StopBlinkingCaret[];
exD.ClearExceptionsRegion[];
lmD.ChangeEditorMenu[run];
inD.MakeCommandsCallable[FALSE];
BEGIN
IF ~confirmed AND ~ConfirmBrackets[hp: intC.runBracketsHouse, fileExtension: ".laurel."L]
  THEN GO TO Done;
String.AppendString[bcdname, intC.runBracketsHouse.text];
IF LocalizeBcd[bcdname] THEN
  BEGIN
  SpliceInIODefs[];
  ProcessDefs.Detach[FORK DoRunBcd[bcdname, hp]];
  RETURN
  END;
EXITS
  Done => NULL;
END;
Cleanup[hp];
END; -- of RunCommand --


DoRunBcd: PROCEDURE [bcdname: STRING, hp: inD.HousePtr] =
BEGIN
RunBcdInLaurel[bcdname];
SpliceOutIODefs[];
LaurelBitmapDefs.SetBitmapNotifyProc[NIL];
Cleanup[hp];
END;  -- of DoRunBcd --


RunBcdInLaurel: PUBLIC PROCEDURE [bcdname: STRING] =
BEGIN

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

  runFile _ NewFile[s, Read, OldFileOnly
    ! FileNameError => {Gripe[exD.fileNotFound]; GO TO out}];
  LockFile[runFile];
  IF ~OurLoad[ ! InsufficientVM => {Gripe[exD.programTooLarge]; GO TO out}]
    THEN GO TO cantExecute;
  cm _ LoaderOps.New[bcd, TRUE, FALSE
    ! BadCode => GO TO cantExecute;
      String.StringBoundsFault => {Gripe[exD.illegalBrackets]; GO TO out};
      VersionMismatch => {Gripe[exD.versionMismatch, name]; GO TO out};
      FileNotFound => {Gripe[exD.requiredFileMissing, name]; GO TO out};
      InsufficientVM => {Gripe[exD.suggestRestart]; OurUnload[]; GO TO out} ];
  IF cm = ControlDefs.NullControl THEN GO TO cantExecute;
  FrameOps.Start[cm ! UNWIND => UnNewConfig[cm.frame]];
  UnNewConfig[cm.frame];
  EXITS
    cantExecute => Gripe[exD.bcdUnexecutable];
    out => NULL;
  END;  -- of RunBcd --

CleanUpAltoLoader: PROCEDURE [seg: SegmentDefs.SegmentHandle] RETURNS [BOOLEAN] =
  BEGIN
  WITH s: seg SELECT FROM
    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
        SegmentDefs.DeleteFileSegment[@s];
    ENDCASE;
  RETURN[FALSE]
  END;  -- of CleanUpAltoLoader --

s: STRING _ [100];
runFile: SegmentDefs.FileHandle _ NIL;
String.AppendString[s, bcdname];
[] _ Storage.Prune[];
clientWords _ 0;
StartExecStorage[];
RunBcd[
  ! exD.SysBugSignal => REJECT;
    ANY => {
      signal, signalArg: CARDINAL;
      [signalArg, signal] _ SIGNAL TrapDefs.SendMsgSignal;
      String.AppendString[s, " got an uncaught signal: "L]; String.AppendOctal[s, signal];
      String.AppendString[s, ", arg: "L]; String.AppendOctal[s, signalArg];
      exD.SysBug[exD.nil, s]}];
FinishExecStorage[];  -- throw away exec storage heap zone.
[] _ SwapperOps.EnumerateObjects[segment, LOOPHOLE[CleanUpAltoLoader]];
IF runFile ~= NIL THEN
  {SegmentDefs.UnlockFile[runFile]; SegmentDefs.ReleaseFile[runFile]};
END;  -- of RunBcdInLaurel --


Cleanup: PROCEDURE [hp: inD.HousePtr] =
BEGIN
intC.keystream.reset[intC.keystream];
[] _ Storage.Prune[];
inD.IndicateCommandFinished[hp];
inD.MakeCommandsCallable[TRUE];
IF inD.CaretIsBlinking[] THEN inD.SetCaretBlinking[intC.target.point, cmMnp];
END;  -- of Cleanup --


LocalizeBcd: PROCEDURE [bcdname: STRING] RETURNS [worked: BOOLEAN] =
BEGIN
OPEN String;
dotLaurel: STRING _ ".laurel"L;
hasExtension: BOOLEAN _ FALSE;
bcdNameLength: CARDINAL _ bcdname.length;
file: VMDefs.FileHandle;
worked _ FALSE;
IF bcdNameLength = 0 THEN GO TO BadFileName;
FOR i: CARDINAL DECREASING IN [0 .. bcdNameLength) DO
  SELECT bcdname[i] FROM
    '. => {hasExtension _ TRUE; EXIT};
    '>, '] => EXIT;
    ENDCASE;
  ENDLOOP;
IF bcdname[0] = '[ THEN
  BEGIN  -- remote file; retrieve it
  localFile: STRING _ [AltoFileDefs.FilenameChars];

  OverwriteOK: PROCEDURE RETURNS [BOOLEAN] =
    BEGIN
    exD.DisplayExceptionLine[exD.remoteFileWillOverwrite, 1];
    RETURN [inD.Confirm[2]];
    END; --OverwriteOK--

  FOR i: CARDINAL _ bcdNameLength, i - 1 UNTIL i = 0 DO
     SELECT bcdname[i - 1] FROM
      ';, '! => bcdNameLength _ i - 1;
      '], '> =>
        BEGIN
        ssd: SubStringDescriptor _ [base: bcdname, offset: i, length: bcdNameLength - i];
        AppendSubString[localFile, @ssd];
        IF ~hasExtension THEN
			BEGIN  ENABLE StringBoundsFault => GO TO BadFileName;
			trailer: STRING _ [10];
			trailerSSD: SubStringDescriptor _ [base: bcdname, offset: bcdNameLength,
				length: bcdname.length - bcdNameLength];
			AppendSubString[trailer, @trailerSSD];
			bcdname.length _ bcdNameLength;
			AppendString[bcdname, dotLaurel];
			AppendString[bcdname, trailer];
			AppendString[localFile, dotLaurel];
			END;
        EXIT
        END;
      ENDCASE => NULL;
    REPEAT
    FINISHED => GO TO BadFileName;
    ENDLOOP;
  exD.DisplayExceptionLine[exD.retrievingRemoteFile, 1];
  worked _ TRUE;
  [] _ opD.Copy[bcdname, localFile, OverwriteOK
    ! opD.FileError =>
      BEGIN
      worked _ FALSE;
      Gripe[exD.nil, "Error during retrieval: "L, errorString];
      CONTINUE;
      END];
  IF worked THEN exD.ClearExceptionsRegion[];
  bcdname.length _ 0;
  AppendString[bcdname, localFile];
  END
ELSE BEGIN
  IF ~hasExtension THEN
	AppendString[bcdname, dotLaurel ! StringBoundsFault => GO TO BadFileName];
  file _ Core.Open[bcdname, read
    ! VMDefs.CantOpen => BEGIN
        SELECT reason FROM
          notFound => GO TO TryRemote;
          alreadyExists => GO TO Unrunnable;
          illegalFileName => GO TO BadFileName;
          ENDCASE;
        END];
  Core.Close[file];
  worked _ TRUE;
  END;
IF worked THEN
  BEGIN  -- bcdname is local now.  Refresh brackets without .laurel.
  bracketsHouse: inD.HousePtr = intC.runBracketsHouse;
  bcdnameSansDotLaurel: STRING _ [inD.maxBracketStringLength];
  ssdDotLaurel: SubStringDescriptor _ [base: dotLaurel, offset: 0, length: dotLaurel.length];
  ssdLocalFileTrailer: SubStringDescriptor _
    [base: bcdname, offset: bcdname.length - dotLaurel.length, length: dotLaurel.length];
  AppendString[bcdnameSansDotLaurel, bcdname];
  IF bcdname.length > dotLaurel.length
    AND EquivalentSubString[@ssdDotLaurel, @ssdLocalFileTrailer] THEN
    bcdnameSansDotLaurel.length _ ssdLocalFileTrailer.offset;
  IF ~EquivalentString[bracketsHouse.text, bcdnameSansDotLaurel] THEN
    BEGIN
    bracketsHouse.text.length _ 0;
    AppendString[bracketsHouse.text, bcdnameSansDotLaurel];
    bracketsHouse.houseRefresher[bracketsHouse];
    END;
  END;
EXITS
BadFileName => Gripe[exD.illegalBrackets];
Unrunnable => Gripe[exD.bcdUnexecutable];
TryRemote =>
  IF Storage.StringLength[intC.runPath] ~= 0 AND intC.runPath[0] = '[ THEN
    BEGIN
    s: STRING _ [inD.maxBracketStringLength];
    AppendString[s, intC.runPath];
    AppendString[s, bcdname];
    exD.DisplayExceptionStringOnLine[bcdname, 1
      ! exD.ExceptionLineOverflow => CONTINUE];
    exD.AppendStringToExceptionLine[" not found.  Will retrieve "L, 1
      ! exD.ExceptionLineOverflow => CONTINUE];
    exD.AppendStringToExceptionLine[s, 1 ! exD.ExceptionLineOverflow => CONTINUE];
    RETURN[inD.Confirm[2] AND LocalizeBcd[s]]; 
    END
  ELSE Gripe[exD.fileNotFound];
END;  -- of LocalizeBcd --


Gripe: PROCEDURE[exception: exD.Exception, s1: STRING _ NIL, s2: STRING _ NIL] =
BEGIN
s: STRING _ [120];
IF exception # exD.nil THEN exD.AppendExceptionString[exception, s];
IF s1 ~= NIL THEN String.AppendString[s, s1];
IF s2 ~= NIL THEN String.AppendString[s, s2];
exD.DisplayExceptionStringOnLine[s, 1];
exD.DisplayExceptionLine[exD.runCanceled, 2];
exD.FlashExceptionsRegion[];
END;  -- of Gripe --


MakeMenuCommandCallable: PUBLIC PROCEDURE
  [menuCommand: LaurelExecDefs.MenuCommand, callable: BOOLEAN _ TRUE] =
-- Sets the callable property of the Laurel screen command menuCommand to be the value of
--   the input paramter callable.
BEGIN
SELECT menuCommand FROM
  user => intC.userCommandHouse.callable _ callable;
  newMail => intC.newMailCommandHouse.callable _ callable;
  mailFile => intC.mailFileCommandHouse.callable _ callable;
  quit => intC.quitCommandHouse.callable _ callable;
  display => intC.displayCommandHouse.callable _ callable;
  hardcopy => intC.hardcopyCommandHouse.callable _ callable;
  delete => intC.deleteCommandHouse.callable _ callable;
  undelete => intC.undeleteCommandHouse.callable _ callable;
  moveTo => intC.moveToCommandHouse.callable _ callable;
  newForm => intC.newFormCommandHouse.callable _ callable;
  answer => intC.answerCommandHouse.callable _ callable;
  forward => intC.forwardCommandHouse.callable _ callable;
  get => intC.getCommandHouse.callable _ callable;
  put => intC.putCommandHouse.callable _ callable;
  copy => intC.copyCommandHouse.callable _ callable;
  run => intC.runCommandHouse.callable _ callable;
  deliver => intC.deliverCommandHouse.callable _ callable;
  ENDCASE => exD.SysBug[];
END;  -- of MakeMenuCommandCallable --

-- Initialization Procedures --

savedEOMstring: STRING;

SpliceExecutiveIntoEditor: PUBLIC PROCEDURE =
BEGIN
target: inD.TextSelectionPtr = @intC.target;
savedEOMstring _ cmMnp.endString;
cmMnp.endString _ "";
IF cmMnp.protectedFieldPtr # NIL THEN prD.UnprotectAllFields[@cmMnp.protectedFieldPtr];
IF ~cmMnp.haveMessage THEN
  BEGIN
  -- initialize the composed message.
  cmMnp.message.formatStart _ cmMnp.message.formatEnd _ 0;
  Editor.RefreshSoThatFirstCharStartsLine[firstChar: 0, firstLine: cmMnp.lines, mnp: cmMnp];
  cmMnp.haveMessage _ TRUE;
  END;
IF target.end ~= 0 THEN Editor.DeUnderlineSelection[target, target];
Editor.InitializeSelection[target];
intC.actionPoint _ 0;
intC.composedMessageEdited _ FALSE;
intC.commandMode _ FALSE;
IF intC.runCommandMode THEN
  BEGIN
  target.point _ vmD.GetMessageSize[cmMnp.message];
  [] _ Editor.MakeCharIndexVisible[target.point, cmMnp];
  Editor.RefreshEndOfMessage[cmMnp];
  END
ELSE BEGIN
  Editor.ResetBuffers[cmMnp];
  Editor.SwapMessageWithDeletionBuffer[cmMnp];
  cmMnp.message.formatStart _ cmMnp.message.formatEnd _ 0;
  Editor.RefreshSoThatFirstCharStartsLine[0, cmMnp.lines, cmMnp];
  intC.runCommandMode _ TRUE;
  END;
IF disC.bitmapInMDS THEN vmD.InvalidateCaches[]; -- free up VM buffers
intC.commandType _ get;
END; -- of SpliceExecutiveIntoEditor --


SpliceExecutiveOutOfEditor: PUBLIC PROCEDURE =
BEGIN
point: vmD.CharIndex _ intC.target.point;
intC.target _ inD.TextSelection[cmMnp, point, point, point, 0, char, FALSE];
intC.commandMode _ TRUE;
inD.StopBlinkingCaret[];
cmMnp.endString _ savedEOMstring;
Editor.RefreshEndOfMessage[cmMnp];
END; -- of SpliceExecutiveOutOfEditor --


ks: StreamDefs.KeyboardHandle;
ds: StreamDefs.DisplayHandle;

execIOState: {out, in} _ out;

SpliceInIODefs: PROCEDURE =
BEGIN
OPEN StreamDefs;
s: StreamHandle;
IF execIOState = in THEN RETURN;
s _ Storage.Node[SIZE[Other StreamObject]];  -- not Keyboard
s^ _ [
  reset: ResetKS,
  get: GetKS,
  putback: PutBackKS,
  put: PutKS,
  endof: EndOfKS,
  destroy: DestroyKS,
  link: NIL,
  body: Keyboard[in: , out: , buffer: ]  -- these are never used
  ];
ks _ LOOPHOLE[s];
ds _ Storage.Node[SIZE[Display StreamObject]];
ds^ _ [
  reset: ResetDS,
  get: GetDS,
  putback: PutBackDS,
  put: PutDS,
  endof: EndOfDS,
  destroy: DestroyDS,
  link: NIL,
  body: Display[
    clearCurrentLine: ClearCurrentLineDS,
    clearLine: ClearLineDS,
    clearChar: ClearCharDS,
    type: ,
    data: ]
  ];
IF intC.editorType = modeless THEN
  [] _ KeyDefs.ChangeKey[LF, [FALSE, LOOPHOLE[Ascii.LF], LOOPHOLE[Ascii.LF]]];
IODefs.SetInputStream[ks]; IODefs.SetOutputStream[ds];
InitializeExecIO[];
execIOState _ in;
END;  -- of SpliceInIODefs --


GetDefaultDisplayStream: PUBLIC PROCEDURE RETURNS [StreamDefs.DisplayHandle] =
-- This hack procedure is needed to avoid UnboundProcedure when StreamIO is started.
BEGIN
RETURN[NIL]
END;  -- of GetDefaultDisplayStream --


SpliceOutIODefs: PUBLIC PROCEDURE =
BEGIN
IF execIOState = out THEN RETURN;
IF intC.editorType = modeless THEN
  [] _ KeyDefs.ChangeKey[LF, [FALSE, LOOPHOLE[Editor.insertDeletionCode],
    LOOPHOLE[Editor.insertDeletionCode]]];
FinalizeExecIO[];
Storage.Free[ks];
Storage.Free[ds];
execIOState _ out;
END;


ShortenTypeScript: PUBLIC PROCEDURE =
BEGIN
composedMessage: vmD.ComposedMessagePtr = vmD.ComposedMessage[cmMnp.message];
charMap: POINTER TO vmD.CMOCharMapTable = composedMessage.charMap;
line: inD.LinePtr;
nDelete: CARDINAL _ 0;
FOR i: vmD.PageNumber IN [0 .. 10) DO
  nDelete _ nDelete + charMap[i].count;
  ENDLOOP;
vmD.DeleteRangeInMessage[[0, nDelete, composedMessage]];
intC.target.point _ vmD.GetMessageSize[composedMessage];
FOR line _ cmMnp.lines, line.nextLine UNTIL line = NIL DO
  line.firstCharIndex _ line.firstCharIndex - nDelete;
  ENDLOOP;
composedMessage.formatEnd _ intC.target.point;
END;  -- of ShortenTypeScript --


END.  -- of ExecSS --
z20461(635)\12121f1 12f0