// AltIOCommand.bcpl -- terminal command processor for AltIO
// Last modified March 14, 1981 3:04 PM
get "altio.decl"
get "streams.d"
get "sysdefs.d"
external
[
//outgoing procedures
AltIOCommand; KeySwitch; GetKeys
PutsWithCursor; GetString; MaxcKeyboard; DisplayMemCode
//incoming procedures
MemRead; MemWrite; LoadSaveFile; BootMicroExec
MemReadBlock32; MemReadBlock40; DisplayParityError
PrintMaxcState; Display20Bit; Display36Bit; Display40Bit; Ding
StartMaxc; StopMaxc; StartEmulator; ResetMaxc; ResetMemory
ReadLM; ReadSM
Ws; Wss; Gets; Puts; Resets; Endofs; Closes
Allocate; Free; DefaultArgs; AddToZone
Zero; MoveBlock; Dismiss; SetTimer; TimerHasExpired; Block
EraseBits; CharWidth; ResetLine; DoubleIncrement; PutTemplate
OpenFile; CallSwat; CounterJunta; CallSubsys
//outgoing statics
commandCtx; maxcKeysCtx
keysCtx; cursorDsp; DisplayPuts
switchStartTenex; switchBoot; switchHalt; protected
loadFilename; bootDiskUnit
//incoming statics
keys; dsp; tDsp; CtxRunning; sysZone; versionText; maxcRunning
adrMTBS; lvUserFinishProc; fatalError; diabloCopy; displayActive
updateDisplayValid; numMemCabs; fpComCm; parityData; topStack; lenTopStack
keepDisplayOn
]
static
[
commandCtx; maxcKeysCtx
keysCtx; cursorDsp; cursorTimer; DisplayPuts
altoNumber; maxcNumber; numberTyped; maxcAdr
cursorOn = false
protected = false
cellOpen = false
switchStartTenex = false
switchBoot = false
switchHalt = false
loadFilename = 0
bootDiskUnit = 0 //default boot from unit 0
bootSaveArea = 1 // save area 1
]
structure String: [ length byte; char↑1,255 byte ]
// ---------------------------------------------------------------------------
let AltIOCommand() be
// ---------------------------------------------------------------------------
//context handling commands to AltIO in middle window
[
// Finish initialization by freeing up the top-level stack
AddToZone(sysZone, topStack, lenTopStack)
SetTimer(lv cursorTimer, 0)
let v = vec 2; maxcNumber = v
let v = vec 1; maxcAdr = v; Zero(maxcAdr, 2)
if loadFilename ne 0 then
[
DefaultExtension(loadFilename, ".Sav")
PutTemplate(dsp,"*n: Load from file: $S*n", loadFilename)
unless LoadSaveFile(loadFilename) do switchHalt = true
Free(sysZone, loadFilename)
]
if switchBoot then
[
Ws("*n: Boot Micro-Exec")
switchHalt = not BootMicroExec(bootDiskUnit, bootSaveArea,
switchStartTenex)
]
test switchHalt
ifso Ws("*n: Halt Maxc")
ifnot
[
unless switchBoot do
[
Ws("*n: Resume Maxc")
StartMaxc()
]
DirectKeys(maxcKeysCtx, tDsp)
]
[ //main command loop
unless cellOpen do Ws((protected? "*n#", "*n:"))
Block() repeatwhile KEndofs() & not fatalError &
parityData>>ParData.flag eq 0
if fatalError then
[
fatalError = false
cellOpen = false
Ding(dsp)
DirectKeys(commandCtx, dsp)
loop
]
if parityData>>ParData.flag ne 0 then
[
DisplayParityError()
cellOpen = false
Ding(dsp)
loop
]
let char = GetNumber()
Puts(dsp, $*s)
switchon char into
[
case $M: case $m:
[
test protected
ifso Oop(char)
ifnot test numberTyped
ifso if Confirm("Micro-start") then
[ StopMaxc(); StartMaxc(altoNumber) ]
ifnot if Confirm("Midas") then ReturnToMidas()
endcase
]
// AltIOCommand (cont'd)
case $R: case $r:
[
test numberTyped % protected
ifso Oop(char)
ifnot
[
Ws("Resume Maxc")
test maxcRunning
ifso Ws(" -- already running")
ifnot if Confirm() then
[
StartMaxc()
DirectKeys(maxcKeysCtx, tDsp)
]
]
endcase
]
case $G: case $g:
[
test protected
ifso Oop(char)
ifnot if Confirm("Go emulator") then
[
StopMaxc()
test numberTyped
ifso StartEmulator(maxcNumber)
ifnot StartEmulator()
DirectKeys(maxcKeysCtx, tDsp)
]
endcase
]
case $H: case $h:
[
test numberTyped % protected
ifso Oop(char)
ifnot if Confirm("Halt Maxc") then StopMaxc()
endcase
]
case $L: case $l:
[
test numberTyped % protected
ifso Oop(char)
ifnot
[
cellOpen = false
let s = Allocate(sysZone, 20)
if GetString("Load from file: ", s) then
[
Puts(dsp, $*n)
DefaultExtension(s, ".Sav")
LoadSaveFile(s)
updateDisplayValid = false
]
Free(sysZone, s)
]
endcase
]
// AltIOCommand (cont'd)
case $B: case $b:
[
test protected
ifso Oop(char)
ifnot if Confirm("Boot Micro-Exec") then
[
cellOpen = false
if numberTyped then bootDiskUnit = altoNumber
if BootMicroExec(bootDiskUnit, bootSaveArea, false)
then DirectKeys(maxcKeysCtx, tDsp)
updateDisplayValid = false
]
endcase
]
case $S: case $s:
[
test protected
ifso Oop(char)
ifnot if Confirm("Start Tenex") then
[
cellOpen = false
if numberTyped then bootDiskUnit = altoNumber
if BootMicroExec(bootDiskUnit, bootSaveArea, true)
then DirectKeys(maxcKeysCtx, tDsp)
updateDisplayValid = false
]
endcase
]
case $Q: case $q:
[
test numberTyped % protected
ifso Oop(char)
ifnot if Confirm("Quit to Executive") then
[ StopMaxc(); finish ]
endcase
]
case $P: case $p:
[
test numberTyped
ifso test altoNumber eq #3301
ifso [ protected = false; Ws("Protection off") ]
ifnot Oop(char)
ifnot [ protected = true; Ws("Protection on") ]
endcase
]
case $V: case $v:
[
PutTemplate(dsp, "Version: $S",versionText)
endcase
]
case $W: case $w:
[
test numberTyped
ifso Oop(char)
ifnot [ Ws("What's up? "); PrintMaxcState()]
endcase
]
// AltIOCommand (cont'd)
case $Z: case $z:
[
test numberTyped % protected
ifso Oop(char)
ifnot
[
Ws("Zap memory")
test maxcRunning
ifso Ws(" -- please halt Maxc first")
ifnot if Confirm() then ResetMemory()
]
endcase
]
case $E: case $e:
[
test numberTyped
ifso Oop(char)
ifnot
[
cellOpen = false
Ws("Emulator state")
test maxcRunning
ifso Ws(" -- please halt Maxc first")
ifnot DisplayEmulatorState()
]
endcase
]
case $D: case $d:
[
test numberTyped
ifso Oop()
ifnot if Confirm((diabloCopy?
"Diablo copy off", "Diablo copy on")) then
diabloCopy = not diabloCopy
endcase
]
case $K: case $k:
[
test numberTyped
ifso Oop()
ifnot if Confirm((keepDisplayOn?
"Keep display off", "Keep display on")) then
keepDisplayOn = not keepDisplayOn
endcase
]
case $/:
[
if numberTyped then MoveBlock(maxcAdr, maxcNumber+1, 2)
DisplayMem(maxcAdr)
endcase
]
case $*n:
[
if numberTyped then
test cellOpen & not protected
ifso DisplayMemCode(MemWrite(maxcAdr, maxcNumber))
ifnot Oop()
cellOpen = false
endcase
]
case $*l:
[
ExamineNext(1)
endcase
]
case $↑: case $W-#100:
[
ExamineNext(-1)
endcase
]
// AltIOCommand (cont'd)
case $*011: //tab
[
test numberTyped
ifso Oop()
ifnot
[
MemRead(maxcAdr, maxcNumber)
maxcAdr!0 = maxcNumber!1 & #37777 //only 18 bits
maxcAdr!1 = maxcNumber!2
Puts(dsp, $*n)
DisplayMem(maxcAdr)
]
endcase
]
case $?:
[
Ws("? Boot, Diablo, Emulator, Go, Halt, Keep, Load, Midas,")
Ws("*n n Micro-start, Protection, Quit, Resume,")
Block()
Ws("*n Start Tenex, Version, What, Zap,")
Ws("*n Maxc memory commands: / ↑ cr lf tab")
endcase
]
case $*177:
[ Ws("XXX "); endcase ]
default:
Oop(char)
]
] repeat
]
// ---------------------------------------------------------------------------
and ReturnToMidas() be
// ---------------------------------------------------------------------------
[
StopMaxc()
let s = OpenFile("Com.cm", ksTypeWriteOnly, charItem, 0, fpComCm)
if s eq 0 then CallSwat("Can't open Com.cm")
Wss(s, "Midas.run/R*n")
Closes(s)
while @lvUserFinishProc ne 0 do (@lvUserFinishProc)()
CounterJunta(AfterCounterJunta)
]
// ---------------------------------------------------------------------------
and AfterCounterJunta() be
// ---------------------------------------------------------------------------
[
let s = OpenFile("Midas.run", ksTypeReadOnly)
if s eq 0 then CallSwat("Can't open Midas.Run")
let userParams = vec 2
userParams>>UPE.type = globalSwitches
userParams>>UPE.length = 2
userParams!1 = $R
userParams!2 = 0
CallSubsys(s, 0, 0, userParams)
CallSwat("CallSubsys returned!")
]
// ---------------------------------------------------------------------------
and ExamineNext(increment) be
// ---------------------------------------------------------------------------
//implements the "line feed" and "up arrow" commands
[
if numberTyped then
test cellOpen
ifso
test protected
ifso Oop()
ifnot DisplayMemCode(MemWrite(maxcAdr, maxcNumber))
ifnot
[ Oop(); return ]
Puts(dsp, $*n)
DoubleIncrement(maxcAdr, increment lshift 12)
DisplayMem(maxcAdr)
]
// ---------------------------------------------------------------------------
and DisplayMem(maxcAdr) be
// ---------------------------------------------------------------------------
[
if maxcAdr!0 rshift 13 ge numMemCabs then
[
Ws(" Address out of bounds.")
Ding(dsp)
cellOpen = false
return
]
let maxcData = vec 3
let code = MemRead(maxcAdr, maxcData)
DisplayMemCode(code)
Block() //let MaxcWatcher report memory errors
if fatalError % code ne 0 then
[ Puts(dsp, $*n); fatalError = false ]
ResetLine(dsp)
Display20Bit(dsp, maxcAdr)
Ws("/ ")
Display40Bit(dsp, maxcData)
Ws(" ")
cellOpen = true
]
// ---------------------------------------------------------------------------
and DisplayEmulatorState() be
// ---------------------------------------------------------------------------
[
let maxcData = vec 2
Ws("*nAccumulators:")
for ac = 0 to #17 do
[
if (ac&3) eq 0 then PutTemplate(dsp, "*n $2O", ac)
Ws(" ")
ReadLM(ac, maxcData)
Display36Bit(dsp, maxcData)
Block() //don't hog the machine
]
Ws("*nPC: ")
ReadSM(emulatorPC, maxcData)
Display36Bit(dsp, maxcData)
]
// ---------------------------------------------------------------------------
and DisplayMemCode(code) be
// ---------------------------------------------------------------------------
if code ne 0 then
PutTemplate(dsp," Memory error ($S) ",
selecton code into
[
case 1: "Bus PE"
case 2: case 3: "Timeout"
default: "??"
])
//----------------------------------------------------------------------------
and GetString(prompt, addr, echo, BreakChar; numargs na) = valof
//----------------------------------------------------------------------------
[
//make a bcpl string from the keyboard
//if echo is true, echo the typed characters to the display.
//BreakChar is a procedure that tests whether a character should
//terminate the string. The default break set consists of just cr.
//returns the terminating character normally.
//returns 0 if del is typed (return to command level).
//addr is the address of the string that should get the result.
//prompt is a prompt string printed in the obvious places
DefaultArgs(lv na, 2, true, IsCR)
if prompt then Ws(prompt)
let count = 0
[
let c = GetKeys()
switchon c into
[
case $*027: //word delete
case $*177: //command delete
[
for i = count to 1 by -1 do
EraseBits(dsp, -CharWidth(dsp, addr>>String.char↑i))
if c eq $*177 resultis false
count = 0
endcase
]
case $*001: //↑A
case $*010: //BS
[
if count ne 0 then
[
EraseBits(dsp, -CharWidth(dsp, addr>>String.char↑count))
count = count-1
]
endcase
]
default:
[
if BreakChar(c) then
[
addr>>String.length = count
resultis c
]
if count le 39 & c ge #40 then
[
count = count + 1
addr>>String.char↑count = c
if echo then Puts(dsp, c)
]
endcase
]
]
] repeat
]
// ---------------------------------------------------------------------------
and IsCR(char) = char eq $*n
// ---------------------------------------------------------------------------
// ---------------------------------------------------------------------------
and GetNumber() = valof
// ---------------------------------------------------------------------------
//inputs an octal number from the keyboard, ignoring spaces.
//returns a 16-bit result in altoNumber and a 40-bit result
//in maxcNumber. numberTyped will be true iff a number was typed.
//returns the terminating character
[
altoNumber = 0
Zero(maxcNumber, 3)
numberTyped = false
let string = vec 20
let res = GetString(0, string, true, NumberTerminator)
if res eq 0 resultis $*177
for i = 1 to string>>String.length do
[
let char = string>>String.char↑i
if char ne $*s then
[
numberTyped = true
altoNumber = altoNumber lshift 3 + char-$0
let overflow = maxcNumber!0 rshift 13
maxcNumber!0 = maxcNumber!0 lshift 3 + maxcNumber!1 rshift 13
maxcNumber!1 = maxcNumber!1 lshift 3 + maxcNumber!2 rshift 13
maxcNumber!2 = (maxcNumber!2 & #010400) lshift 3 +
(char-$0) lshift 12 + overflow lshift 8
]
]
resultis res
]
// ---------------------------------------------------------------------------
and NumberTerminator(c) = c ne $*s & (c ls $0 % c gr $7)
// ---------------------------------------------------------------------------
// ---------------------------------------------------------------------------
and DefaultExtension(string, defaultExt) be
// ---------------------------------------------------------------------------
[
let n = string>>String.length
for i = 1 to n do if string>>String.char↑i eq $. return
for i = 1 to defaultExt>>String.length do
string>>String.char↑(n+i) = defaultExt>>String.char↑i
string>>String.length = n+defaultExt>>String.length
]
// ---------------------------------------------------------------------------
and Confirm(prompt; numargs na) = valof
// ---------------------------------------------------------------------------
[
if na gr 0 then Ws(prompt)
Ws(" [confirm] ")
[
switchon GetKeys() into
[
case $Y: case $y: case $*n: case $.:
[ Ws("Yes."); resultis true ]
case $N: case $n: case $*177:
[ Ws("No."); resultis false ]
]
Oop()
] repeat
]
// ---------------------------------------------------------------------------
and Oop(char; numargs na) be
// ---------------------------------------------------------------------------
[
if na gr 0 then Puts(dsp, char)
Ws(" ? ")
Ding(dsp)
Resets(keys)
]
// ---------------------------------------------------------------------------
and KeySwitch() be
// ---------------------------------------------------------------------------
//context that directs keyboard input to the correct window
[
Dismiss(4)
if @#177036 eq -1 then //ignore if either ctrl or shift is down
[
if @#177035 eq #177775 then DirectKeys(commandCtx, dsp)
if @#177037 eq #177773 % @#177037 eq #177573 then
DirectKeys(maxcKeysCtx, tDsp)
]
//"ding" if shift-swat is typed
if @#177036 eq #177677 &
@#177037 eq #177773 % @#177037 eq #177573 then Ding(dsp)
] repeat
// ---------------------------------------------------------------------------
and DirectKeys(ctx, ds) be
// ---------------------------------------------------------------------------
[
if cursorOn then EraseCursor()
keysCtx = ctx
cursorDsp = ds
displayActive = true
]
// ---------------------------------------------------------------------------
and GetKeys() = valof
// ---------------------------------------------------------------------------
[
Block() repeatwhile KEndofs()
displayActive = true
EraseCursor()
resultis Gets(keys)
]
// ---------------------------------------------------------------------------
and KEndofs() = valof
// ---------------------------------------------------------------------------
[
Dismiss(4) //reduce cost of contexts polling for keyboard input
if CtxRunning eq keysCtx & TimerHasExpired(lv cursorTimer) then
test cursorOn
ifso EraseCursor()
ifnot
[
Puts(cursorDsp,$|)
cursorOn = true
cursorDsp>>ST.puts = PutsWithCursor
SetTimer(lv cursorTimer, 50)
]
resultis keysCtx ne CtxRunning % Endofs(keys)
]
// ---------------------------------------------------------------------------
and EraseCursor() be
// ---------------------------------------------------------------------------
[
if cursorOn then
[
EraseBits(cursorDsp, -CharWidth(cursorDsp, $|))
cursorOn = false
cursorDsp>>ST.puts = DisplayPuts
SetTimer(lv cursorTimer, 50)
]
]
// ---------------------------------------------------------------------------
and PutsWithCursor(str, char) be
// ---------------------------------------------------------------------------
[
displayActive = true
if str eq cursorDsp & cursorOn then EraseCursor()
DisplayPuts(str, char)
]