//Mcmd.bcpl--command menu, error, and timeout procedures
//Last edited: 2 January 1980

get "streams.d"
get "mdecl.d"
get "mcommon.d"

external [
// OS
Dvec; AddToZone; Allocate; Free; sysZone; keys
Resets; Endofs; Gets; ReadBlock; WriteBlock; Closes; CreateDiskStream
CallSwat; DoubleAdd; Timer; GotoLabel; CallersFrame; GotoFrame

// MINIT0
DtachFP; RunProgFP; MStatus; FirstStatic; LastStatic; NStatics
Storage; EndStorage; StateBlock; StatePtr; StateEnd

// MIDAS
MidasSwat; StartTimer; TimerGoing; Initialized; BegCF; TopFrame
Resume; StateFileSize; @NestedCFiles

// MASM
Wss; @WssCSS; PutsCSS; ResetsCSS
DummyCall1; ErrorProtect; @AbortLabel; @AbortFrame

// MIOC
Wns

// MTXTBUF
ClearInText; InputStream; InputTextBuffer; TxtBNewChar

// MOVERLAY
KillOverlays; FlushOverlays; PeelOverlay
OverlayZone; OverlayFlushed

// MSYM
StreamFromTextName

// MDISP
MakeDispZoneAvail; SetDisplay; Blink; DisplayOff

// MRGN
DriverLoop; UpdateDisplay; RemoveFromEveryTimeList
ErrorFlag; AllowedRgn; PaintRgnLine

// MMENU
CreateAction; ForgetTemporaryActions; ExecuteTextCmdStream
FormMenu; DoTextAction; CommandCount; SkipCommandCount; CFileStream
@WsMarkA; WssMark; ThisAction

// MGO
@QuitF

// MCMDOV
TextCmdOutStream

// xxACTIONS
CmdDumpAct; CmdStartWCAct; CmdStopWCAct; CmdShowCmdAct
CmdConcealAct; CmdErrorContinueAct; CmdErrorAbortAct
CmdCFileAbortAct
LastAction; FirstCmdAction; LastCmdAction; TimeTimeOut
HWCFActions; NHWCFActions

// Machine dependent
FormHWMenu; DetachHardware

//Defined here
WnsCSS; WnsCSSD; WnsCS1; WnsCS1D; CmdDoRC; RunProgMenu; ReadCMenu
FormCmdMenu; ShowActions; DisplayError; ErrorExit; ErrorAbort
ConfirmAct; StartCmdOverlay; StartLargeOverlay; QuitCmdOverlay
SetAbort; SetAbortPure; CmdAbort; CmdWriteState; RestoreState
TEveryTime; TimeOutEveryTime
CmdCommentStream; CmdCS1; CFOutStream
SavedLoadText; Confirmed; LoadDone; ShowActionForm
CmdMDFS; CmdAltMenuP; @CmdAbortAct; PassiveOnly

// Defined here for init only
DoOverlay; EndError; CmdRunProg; ExecuteCFile
ProgramAct; NPrograms; ReadCAct; NReadCFiles
]

static[
CmdMDFS; CmdCommentStream; CmdCS1; CmdEString2; CmdAltMenuP
CmdQuitOverlayF; LoadDone = false; Confirmed = false
ShowActionForm = false; SavedLoadText
ProgramAct; NPrograms; ReadCAct; NReadCFiles
PassiveOnly = false; TEveryTime = 0; CFOutStream = 0; @CmdAbortAct
]

// Procedures made external

let WnsCSS(Num) be Wns(CmdCommentStream,Num,0,8)
and WnsCSSD(Num) be Wns(CmdCommentStream,Num,0,10)
and WnsCS1(N) be Wns(CmdCS1,N,0,8)
and WnsCS1D(N) be Wns(CmdCS1,N,0,10)


and FormCmdMenu() be FormMenu(CmdMDFS,FormCmdmenuText)


//Action subr is called with args
// (1) menu stream (always ItemStream)
// (2) MDFS (always CmdMDFS for command menu)
// (3) Mouse button union
// (4) arg from ActionBlock

and FormCmdmenuText(S,MDFS) be
[ //Initialize the ScreenTV stuff for this region to all blanks and
//set dirty
for L = 0 to MDFS>>Rgn.Height-1 do
PaintRgnLine(MDFS,L,table [ 0 ] )
test CmdAltMenuP ne 0
ifso CmdAltMenuP()
ifnot
[
//Kludge to allow partitioning of the main command menu actions according
//to flags in the Action structure. At the moment only two flags are used:
//ifPassive and ifActive. Machine-dependent code manipulates the
//PassiveOnly flag to control what’s displayed.
for I = FirstCmdAction to LastCmdAction by size Action/16 do
[ test PassiveOnly
ifso if I>>Action.ifPassive eq 0 then loop
ifnot if I>>Action.ifActive eq 0 then loop
WsMarkA(I)
]
if LoadDone & not PassiveOnly then WsMarkA(CmdDumpAct)
WsMarkA(ShowActionForm ? CmdConcealAct,CmdShowCmdAct)
WsMarkA(TextCmdOutStream eq 0 ? CmdStartWCAct,CmdStopWCAct)
FormHWMenu()
]
]


and ShowActions(Act1,FirstAct,NActs) be
[if Act1 ne -1 then WsMarkA(Act1)
for I = 1 to NActs do
[ WsMarkA(FirstAct); FirstAct = FirstAct+(size Action/16)
]
]


and SetAbort(lvProc,Arg) be CmdAbortAct =
CreateAction("Abort",lvProc,Arg,0,$C-100B)


//Like SetAbort but don’t clear comment lines at onset of action.
and SetAbortPure(lvProc,Arg) be
[SetAbort(lvProc,Arg)
CmdAbortAct>>Action.ifNoRes = 1
]


and CmdAbort(nil,nil,nil) be
[ResetsCSS(); WssCSS("XXX"); QuitCmdOverlay(0)
]

//Called both as an action (with Menu eq ReadCMenu) and during
//initialization (with Menu eq RunProgMenu).
and CmdDoRC(lvMenu,nil,nil) be
[if CmdAltMenuP ne 0 then
ErrorAbort("RdCmds ill. inside an action")
unless TimerGoing do StartTimer()
SkipCommandCount = 0
//Use menu when junk numbers are on input line
if (InputTextBuffer!1 le $9) & (InputTextBuffer!1 ge $0)
then Resets(InputStream)
if InputTextBuffer!0 eq 0 do//Get name from menu?
[ let DisplayState = SetDisplay(false)//Display on
SetAbort(lv CmdAbort,0)
SkipCommandCount = StartCmdOverlay(rv lvMenu)
SetDisplay(DisplayState)
]
//Flush stack and continue in MIDAS.BCPL
GotoLabel(TopFrame,BegCF,0)
]


and ExecuteCFile(fname,MBunion,nil) = valof
[Wss(InputStream,fname)
//The MProc word in the Action table for some of the ReadCMenu actions
//contains the entry-skip-count or 0 if no skip
resultis QuitCmdOverlay(ThisAction>>Action.lvMProc)
]


and ReadCMenu() be
[ShowActions(CmdAbortAct,LastAction+(NPrograms*(size Action/16)),
NReadCFiles)
ShowActions(-1,HWCFActions,NHWCFActions)
]

and RunProgMenu() be ShowActions(CmdAbortAct,LastAction,NPrograms)


//At the moment, this procedure is pretty clean. However, if at some
//future time code is added to save the state of the current program
//prior to a Dtach, then will have to add the commented code below.
//***NOTE CHANGES HERE FOR D0***
and CmdRunProg(Dtach,nil,nil) be
[if CmdAltMenuP ne 0 do
[ if not MStatus>>MStatus.MachRunning then
ErrorAbort("RunProg/Boot ill. inside an action")
// RemoveFromEveryTimeList(QuitF)
// ForgetTemporaryActions()
// FlushOverlays()
//TimeOut will be on when Dtach’ing from a Go inside a command file.
// if TEveryTime ne 0 do
// [ RemoveFromEveryTimeList(TEveryTime); TEveryTime = 0
// ]
]
SetDisplay(true)
//if Dtach do
//[ if CFileStream ne 0 do
// [ Closes(CFileStream); CFileStream = 0; NestedCFiles = 0
// ]
// if TextCmdOutStream ne 0 do
// [ Closes(TextCmdOutStream); TextCmdOutStream = 0
// ]
//]
if CFileStream eq 0 then StartTimer()
MStatus>>MStatus.RunProg = Dtach ? 2,1
MStatus>>MStatus.CFileStream = CFileStream //For RdCmds
MStatus>>MStatus.CFOutStream = CFOutStream //For Open/AppendOutput
MStatus>>MStatus.TextCmdOutStream = TextCmdOutStream //For WrtCmds
MStatus>>MStatus.ShowActionForm = ShowActionForm
MakeDispZoneAvail()
//OverlayFlushed = true
while PeelOverlay() do [ ]
//Reset Midas and continue execution at "Resume" in MIDAS.BCPL
RestoreState((Dtach ? DtachFP,RunProgFP),true)
]


and TimeOutEveryTime(nil) be
[let Now = vec 1; Timer(Now); DoubleAdd(Now,TimeTimeOut)
//Timed out or completed?
if (Now!0 ge 0) % (CommandCount le 0) do
[ RemoveFromEveryTimeList(TEveryTime); TEveryTime = 0
if CommandCount > 0 do
[ SkipCommandCount = 1
//DoTextAction should not return because QuitCmdOverlay will be called
DoTextAction($C - 100B)
]
]
]


//Start a very large overlay: First call InitP to build the actions;
//InitP returns lvProc for a procedure that will return the menu-forming
//procedure. Then flush out OverlayZone, add large storage blocks from
//the stack and sysZone to OverlayZone, and call StartCmdOverlay(lvProc);
//overlays needed will swap in during execution. After QuitCmdOverlay,
//flush everything and clean up.
//**All of callers leading to StartLargeOverlay must be resident.
and StartLargeOverlay(lvInitP,A1,A2,A3,A4; numargs NA) be
[lvInitP = DummyCall1(lvInitP,NA-1,A1,A2,A3,A4)
FlushOverlays()
//sysZone block will be used for the D1SimIFU overlay.
let ExtraSysZone = Allocate(sysZone,#5100)
if ExtraSysZone eq 0 then MidasSwat(SmallsysZone)
AddToZone(OverlayZone,ExtraSysZone,#5100)
//Use Dvec so stack depth of DummyCall1(..) above won’t add to the #3100
//words here. Nesting of DummyCall1, SimGo, SetupIMA, PrCCV, SearchBlocks,
//GetBlock, ... is quite deep.
let ExtraStack = #3100
Dvec(StartLargeOverlay,lv ExtraStack)
//This block will be used for D1SimCon overlay.
AddToZone(OverlayZone,ExtraStack,#3100)
StartCmdOverlay(lvInitP)
KillOverlays()//Rebuilds zone if display is off
Free(sysZone,ExtraSysZone)
]


//Initiate an action which uses an alternate command menu.
//Action terminates with QuitCmdOverlay(Result) and Result is returned,
//or by ErrorExit or DisplayError, which return 0.
//StartCmdOverlay establishes a super-errorset that overrides the
//more local errorsets established by ErrorProtect.
//lvInitP may be either a menu-forming procedure or lvProc for a procedure
//that returns the menu-forming procedure as its result.
and StartCmdOverlay(lvInitP,A1,A2,A3,A4; numargs NA) = valof
[let DisplayState = DisplayOff
let oldCmdAltMenuP,oldCmdQuitOverlayF = CmdAltMenuP,CmdQuitOverlayF
CmdAltMenuP = lvInitP > LastStatic ? lvInitP,
DummyCall1(lvInitP,NA-1,A1,A2,A3,A4)
FormCmdMenu()
//DoOverlay has to be called by ErrorProtect so that AbortFrame and
//AbortLabel will be restored after QuitCmdOverlay before any other errors
//can occur.
let Result = ErrorProtect(lv DoOverlay)
CmdAltMenuP,CmdQuitOverlayF = oldCmdAltMenuP,oldCmdQuitOverlayF
FormCmdMenu()
//Restore display to its old on/off state
SetDisplay(DisplayState); resultis Result
]


//In command files:
//For "Go" CommandCount will be > 0, so DriverLoop() will be called
//For "AltIO", CommandCount will be 0, so the subsidiary menu commands
//will come from the command file.
//DoOverlay is called from StartCmdOverlay and Init2.
and DoOverlay() = valof
[CmdQuitOverlayF = CallersFrame()
test (CFileStream ne 0) & (CommandCount le 0) & (not ErrorFlag)
ifso ExecuteTextCmdStream(CFileStream)
ifnot DriverLoop()
//The above calls don’t return--QuitCmdOverlay(..) will be called
MidasSwat(CFileRetn)
]


//Used by actions to return from command overlays; by DisplayError and
//ErrorExit to abort either the command overlay or last ErrorProtect call.
and QuitCmdOverlay(Result) be
[if CmdAltMenuP ne 0 do
[ ForgetTemporaryActions(); GotoFrame(CmdQuitOverlayF,Result)
]
GotoLabel(AbortFrame,AbortLabel,Result)
]


//If numargs is > 3 then CmdCommentStream is untouched
and DisplayError(S1,S2,S3,NoCSS; numargs NA) = valof
[Confirmed = false
if not Initialized then CallSwat(S1)
let DisplayOff = SetDisplay(false)
if NA < 4 do
[ ResetsCSS()
if NA > 2 then WssCSS(S3)
WssCSS(S1)
]
CmdEString2 = NA > 1? S2, 0
ErrorFlag,AllowedRgn = true,CmdMDFS
let R = StartCmdOverlay(ErrorMenu)
ErrorFlag = false
SetDisplay(DisplayOff)
if R then resultis true//Continue
//Return 0 from StartCmdOverlay or last ErrorProtect(..)
QuitCmdOverlay(0)
]

//P is true to continue from error, false to abort command
and EndError(P,nil,nil) be
[if P then GotoFrame(CmdQuitOverlayF,P)
QuitCmdOverlay(0)
]


and ErrorMenu() be
[if CmdEString2 ne 0 then WssMark(CmdEString2,CmdErrorContinueAct)
//Presently cannot allow abort of command within CFile because on
//OpenFile errors this crashes.
WsMarkA((CFileStream ne 0 ? CmdCFileAbortAct,CmdErrorAbortAct))
]


and ErrorPrin(S1,S2,S3; numargs NA) be
[if NA < 1 then S1 = "No good"
Confirmed = false
test Initialized
ifso WssCSS(S1)
ifnot CallSwat(S1)
if NA > 1 then WssCSS(S2)
if NA > 2 then WssCSS(S3)
test CFileStream ne 0
ifso DisplayError(0,"Continue",0,true)
ifnot
[ SetDisplay(false); Blink()
]
]


//Prints the three argument strings on CmdCommentStream (prints
//"No good" if none of these strings is given); then, if inside a
//command overlay calls DisplayError and exits from the command overlay
//if the user continues; if not inside a command overlay, exits from the
//last ErrorProtect call with a result of 0.
and ErrorExit(S1,S2,S3; numargs NA) be
[DummyCall1(lv ErrorPrin,NA,S1,S2,S3)
QuitCmdOverlay(0)
]


//Abort action not in command overlay (actions that are illegal during
//a command overlay, such as SetValue, cannot call ErrorExit because
//they crash Midas).
and ErrorAbort(S1,S2,S3; numargs NA) be
[DummyCall1(lv ErrorPrin,NA,S1,S2,S3)
GotoLabel(AbortFrame,AbortLabel,0)
]


and ConfirmAct(Str,TV) = valof
[if Confirmed then
[ Confirmed = false; resultis true
]
WssCSS(Str)
for I = 1 to TV!0 do PutsCSS(TV!I)
WssCSS(" [confirm]")
UpdateDisplay()
let DisplayOff = SetDisplay(false)
[ if not Endofs(keys) then switchon Gets(keys) into
[
case $n: case $N: case 177B: case $C-100:
ResetsCSS(); WssCSS("XXX")
SetDisplay(DisplayOff); resultis false

case $.: case $Y: case $y: case $*N:
ResetsCSS(); SetDisplay(DisplayOff); resultis true

default: Blink()
]
] repeat
]

//The state of the program consists of its statics (all of which are saved),
//some page zero items (explicitly saved by calls on SaveStatics), and the
//core between StateEnd and EndStorage when SaveState is called.
//The address of the first static (Layout!26) and last static (Layout!27)
//are obtained from the layout vector in the Executive’s call to Midas.
//It seems wasteful to save all procedure statics, but this is necessary
//if the Overlay package is used, and it is easier to save all than be
//selective. There is no provision for enumerating individual blocks of
//storage outside the region delimited by StateEnd and (final) EndStorage.

//SaveState can be called multiple times, allowing the program to
//fire up with different initial information.
and SaveState(S) = valof
[if S eq 0 then MidasSwat(BadSaveStateFP)
//Copy selected items (zrel statics) into StateBlock
for I = 0 to StatePtr-2 by 2 do
[ StateBlock!(I+1) = rv StateBlock!I
]
WriteBlock(S,FirstStatic,NStatics)
let BufSize = StateEnd-EndStorage
WriteBlock(S,EndStorage,BufSize)
Closes(S)
//Return file size for statistical purposes
resultis NStatics+BufSize
]


//Must be resident
and CmdWriteState(nil,nil,nil) be
[if InputTextBuffer!0 eq 0 then ErrorAbort("Missing state file name")
let S = StreamFromTextName(InputTextBuffer,
".STATE",ksTypeWriteOnly,wordItem)
TxtBNewChar(#177); KillOverlays()
let C = CFileStream; CFileStream = 0
StateFileSize = SaveState(S)
CFileStream = C
]


//S is a stream argument for the file created by SaveState. reinitFlag
//should be true when RestoreState is called during initialization.
//The program can reinitialize itself during operation by calling
//RestoreState with reinitFlag false.
and RestoreState(FP,reinitFlag) be
[let S = CreateDiskStream(FP,ksTypeReadOnly)
if S eq 0 then MidasSwat(BadRestoreStateFP)
let newEndStorage = EndStorage
ReadBlock(S,FirstStatic,NStatics)
if not reinitFlag then
if newEndStorage ne StateEnd then MidasSwat(MidasIncompatible)
let WC = StateEnd - EndStorage
let N = ReadBlock(S,EndStorage,WC)
if N ne WC then MidasSwat(StateFileClobbered)
for I = 0 to StatePtr-2 by 2 do
[ rv (StateBlock!I) = StateBlock!(I+1)
]
Closes(S); GotoLabel(TopFrame,Resume,0)
]