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