// A L T O E X E C U T I V E
// Main Module - NewCommand.bcpl
// Copyright Xerox Corporation 1979, 1980
// Ed McCreight
// last modified by R. Johnsson, May 22, 1980 2:33 PM
// The command processor is created from a large number
// of modules, of which this is the driver module. These
// modules are contained in Executive.DM, and loaded by
// @Load-Executive.Cm@.
get "sysdefs.d"
get "streams.d"
get "altofilesys.d"
get "BcplFiles.d"
get "COMSTRUCT.BCPL"
static [
OOPS
DIDEXPAND
DIRHDBLK
BANG
CALLBRAVO
DIRSTATE
EOLWIDTH
CZ
SYSTEMDIR
ComCm
RemCm
DefaultScroll
CheckZoneErr = 0
mesaBankMask = 177777b
userParamsVec
]
let MAIN(layout, userParams, CFA) be
[ let basicZone = vec 20000
CZ = InitializeZone(basicZone, 20000, STORAGEGONE,
CheckZoneErr)
Executive(Initialize(CFA,layout))
]
and Executive(BQ) be
[ let LQ = vec size QS/16 // INIT LINE QUEUE
INITQ(LQ)
[ WriteDiskDescriptor()
if LOOKFORCTLC() then
[ EMPTYOUTQ(BQ)
Resets(RemCm)
TruncateDiskStream(RemCm)
CleanupDiskStream(RemCm)
]
if OsFinishCode eq fcAbort then
[ OsFinishCode = fcOK
EMPTYOUTQ(BQ)
PUTQR(BQ, CONTROLC)
]
EMPTYOUTQ(LQ)
CALLBRAVO = false
unless EDITCHARS(LQ, BQ, ">") do
[ EMPTYOUTQ(BQ)
loop
]
APPENDQ(BQ, LQ, BQ)
INITQ(LQ)
if CALLBRAVO then
[ let LINEFILE = MyOpenFile("Line.Cm",
ksTypeWriteOnly, charItem)
GETQR(BQ) // drop the final CR
QFTOSTREAM(BQ, LINEFILE)
Closes(LINEFILE)
let GoodFP(fp,nil,nil,nil,nil) =
fp ne 0 & fp>>FP.leaderVirtualDa ne 0
let ughExists = MyOpenFile("Ugh.run",ksTypeReadOnly,
0,0,0,0,0,0,0,GoodFP);
let BCS = ughExists?
"Ugh/t Line.Cm",
"Bravo/n Line.Cm"
for I=1 to BCS>>STRING.length do
PUTQR(BQ, BCS>>STRING.char↑I)
loop
]
DIDEXPAND = false
unless EXPAND(LQ, BQ) do
[ EMPTYOUTQ(BQ)
loop
]
if Cancel() then loop
RemoveUpArrows(LQ)
if DIDEXPAND then RETYPE(LQ, WRITE, $>)
DIDEXPAND = false
if Cancel() then loop
let SUBSYSNAME = vec 128
let MYDE = nil
let suffixes =
".RUN.;.IMAGE.;.BCD.;.~.;**.RUN.;**.IMAGE.;**.~.;**.BCD."
[ // loop to expand ".bcd" files
MYDE = GETSUBSYS(LQ, SUBSYSNAME, suffixes)
if MYDE eq NONAME % MYDE eq NOFILE then break
test NameHasSuffix(SUBSYSNAME, ".BCD")
ifso [
SUBSYSNAME = "Mesa.Image"
PUTQF(LQ, $*S)
for i = SUBSYSNAME>>STRING.length to 1 by -1 do
PUTQF(LQ, SUBSYSNAME>>STRING.char↑i)
suffixes = ";"
]
ifnot break
] repeat
if MYDE eq NONAME then loop
if MYDE eq NOFILE then
[ WRITE(FORMATN(
"*NThere is no subsystem named <S>.",
SUBSYSNAME))
loop
]
if Cancel() then loop
if DIDEXPAND then RETYPE(LQ, WRITE, $>)
if Cancel() then loop
if MYDE>>MYDE.TYPE eq ISFILE then RETYPE(LQ, WriteSys, $>)
if Cancel() then loop
QFToComCm(LQ)
let BQCopy = vec size QS/16
INITQ(BQCopy)
COPYQ(BQ, BQCopy)
Resets(RemCm)
QFTOSTREAM(BQCopy, RemCm)
TruncateDiskStream(RemCm)
// If stream is at end of file (which this is) necessary to flush to disk....
CleanupDiskStream(RemCm)
if Cancel() then loop
switchon MYDE>>MYDE.TYPE into
[ case ISFILE:
[
let streamParameter = 0;
Closes(ComCm); ComCm = 0
if NameHasSuffix(SUBSYSNAME,".IMAGE") then
[ streamParameter = MyOpenFile(SUBSYSNAME, ksTypeReadOnly,
wordItem,0,0,OldSysErr)
SUBSYSNAME = "RunMesa.run"
]
let F = MyOpenFile(SUBSYSNAME, ksTypeReadOnly,
wordItem,0,0,OldSysErr)
if F eq 0 then
[ WRITE(FORMATN(
"I thought there was a subsystem named <S>, but I can't find it.",
SUBSYSNAME))
loop
]
EMPTYOUTQ(BQ)
if not ValidSubsys(SUBSYSNAME, F) % Cancel() then
[ if streamParameter ne 0 then Closes(streamParameter)
if F ne 0 then Closes(F)
if not Cancel() then PUTQR(BQ,CONTROLC)
loop
]
Closes(RemCm)
WIPEDIRBLK()
Closes(SYSTEMDIR)
(@lvUserFinishProc)(0)
// finishing successfully
AddMesaParameters(streamParameter)
CallSubsys(F, BANG, false, userParamsVec)
]
endcase
case ISLOCALSUBSYS:
CALLIFLOCAL(MYDE)
]
] repeat
]
and ValidSubsys(name, subsys) = valof
[
let args = vec lBLV
ReadBlock(subsys, args, size SV.H/16)
ReadBlock(subsys, args, lBLV)
unless Usc(#1000,args>>BLV.startOfStatics) le 0 &
Usc(args>>BLV.startOfStatics,args>>BLV.endOfStatics) le 0 &
Usc(#1000,args>>BLV.startOfCode) le 0 &
Usc(args>>BLV.startOfCode,args>>BLV.afterLastCodeWord) le 0 do
[
WRITE(FORMATN("*n<S> does not appear to be a valid .run file.*nType ↑C to abort, any other character to press on.", name))
Resets(keys)
let c = Gets(keys)
if c eq CONTROLC then resultis false
]
Resets(subsys)
resultis true
]
and NameHasSuffix(name,suf) = valof
[ let ofs = name>>STRING.length-suf>>STRING.length
if ofs ls 0 then resultis false
for i = 1 to suf>>STRING.length do
if Capitalize(name>>STRING.char↑(ofs+i)) ne suf>>STRING.char↑i then resultis false
resultis true
]
and RETURNIT(MYDE, X) = MYDE
and QFToComCm(Q) be
[ if ComCm eq 0 then
ComCm = MyOpenFile("Com.Cm", ksTypeReadWrite,
charItem)
if ComCm eq 0 then (@lvSysErr)(0,0)
Resets(ComCm)
QFTOSTREAM(Q, ComCm)
TruncateDiskStream(ComCm)
]
and GETSUBSYS(Q, STR, SUFFIX) = valof
[ let PrefaceQ = vec size QS/16
let FileNameQ = vec size QS/16
let FNQCopy = vec size QS/16
let SuffixQ = vec size QS/16
let NewFileNameQ = vec size QS/16
INITQ(PrefaceQ)
INITQ(FileNameQ)
INITQ(FNQCopy)
INITQ(SuffixQ)
INITQ(NewFileNameQ)
BANG = false
XFERQWHILE(GETQF, PUTQF, Q, PUTQR, PrefaceQ, IsntCommandChar)
XFERQWHILE(GETQF, PUTQF, Q, PUTQR, FileNameQ, IsCommandChar)
COPYQ(FileNameQ, FNQCopy)
QFTOSTRING(FNQCopy, STR)
STR>>STRING.char↑(STR>>STRING.length+1) = 0 // PAD LAST WORD
let FNDE = ISEMPTYQ(FileNameQ)?
NONAME, valof
[ let SufLen = SUFFIX>>STRING.length
let NextSufChar = 1
while NextSufChar le SufLen do
[ EMPTYOUTQ(SuffixQ)
while (NextSufChar le SufLen) &
(SUFFIX>>STRING.char↑NextSufChar ne $;) do
[ PUTQR(SuffixQ,
SUFFIX>>STRING.char↑NextSufChar)
NextSufChar = NextSufChar+1
]
if FilesWithSuffix(FileNameQ, SuffixQ,
NewFileNameQ)
eq 1 then
[ if COMPAREQ(FileNameQ, NewFileNameQ)
ne 0 then
DIDEXPAND = true
EMPTYOUTQ(FileNameQ)
COPYQ(NewFileNameQ, FileNameQ)
COPYQ(NewFileNameQ, FNQCopy)
QFTOSTRING(FNQCopy, STR)
EMPTYOUTQ(SuffixQ)
resultis MAPDIR(NewFileNameQ, RETURNIT)
]
EMPTYOUTQ(NewFileNameQ)
NextSufChar = NextSufChar+1
]
EMPTYOUTQ(SuffixQ)
resultis NOFILE
]
APPENDQ(FileNameQ, PrefaceQ, FileNameQ)
let switchCount = 0
let C = nil
while valof
[ if ISEMPTYQ(Q) then resultis false
C = GETQF(Q)
unless ISITEMCHAR(C) do
[ PUTQF(Q, C)
resultis false
]
resultis true
] do
test C eq $!
ifnot [ PUTQR(FileNameQ, C)
if (C ne $/) &
(switchCount ls lUserParams-1) then
[ switchCount = switchCount+1
userParamsVec!switchCount = C
]
]
ifso [ BANG = true
let LastFNC = GETQR(FileNameQ)
let NextC = GETQF(Q)
PUTQF(Q, NextC)
if ISFILECHAR(NextC) %
LastFNC ne $/ then
PUTQR(FileNameQ, LastFNC)
]
APPENDQ(Q, FileNameQ, Q)
userParamsVec!(switchCount+1) = 0
userParamsVec>>UPE.type = globalSwitches
userParamsVec>>UPE.length = switchCount+1
resultis FNDE
]
and AddMesaParameters(s) be
[
if s eq 0 then return
let up = userParamsVec
until up!0 eq 0 do up = up + up>>UPE.length
// add bank mask if not 177777b
if mesaBankMask ne 177777b & lUserParams-(up-userParamsVec) gr 3 then
[
up>>UPE.type = privateType + 10
up>>UPE.length = 2
up!1 = mesaBankMask
up = up+2
@up = 0
]
// add user parameter of type open stream if s ne 0
if s ne 0 & lUserParams-(up-userParamsVec) gr 3 then
[
up>>UPE.type = openStreams
up>>UPE.length = 2
up!1 = s
up = up+2
@up = 0
]
]
and CALLIFLOCAL(MYDE) = valof
[ unless MYDE>>MYDE.TYPE eq ISLOCALSUBSYS do resultis false
Resets(ComCm)
RESETPAGE()
WRITE("*N~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*N")
// The following mumbo-jumbo is used instead of a
// more straightforward alternative so that in case
// of an overlay fault the overlay
// code will be able to figure out where we really wanted
// to go.
CallWithNArgs(MYDE>>MYDE.pStatic, 2,
ComCm, USERSTR)
WRITE("~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~")
MAKETIMELINE()
resultis true
]