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