// OnceOnly.bcpl -- OnceOnly Initialization Module
// Copyright Xerox Corporation 1979, 1983
// last modified January 8, 1983  3:49 PM by Boggs

get "AltoDefs.d"
get "SysDefs.d"
get "Disks.d"
get "AltoFileSys.d"
get "Streams.d"
get "Time.d"
get "COMSTRUCT.BCPL"

// this code is overwritten after execution

external [	// imported from ExecInit
	ClockWrong
	DiskInfo
	DiskName
	ExecSysErr
	InCaseOfDemise
	NetNumber
	OldUserFinishProc
	OverlayArea
	OverlayAreaSize
	screenColor
	ShowDiskInfo
	SpaceAbove
	SpaceBelow
		// exported to ExecInit
	OnceOnlyInitCode
	]

manifest	[
	DisplayHead = #420
	screenWhite = 0
	screenBlack = 1
	]

static [
	BootFileIllegal
	FullDspLine
	screenColor = screenWhite
	]

let OnceOnlyInitCode(CFA) = valof

	[
	SetKeyboardProc(CatchBlankKeys, Allocate(CZ,10), 10)

	FixupCursor()
	// Initialize overlays
	manifest [ lODV = 60 ]

	OverlayArea = OnceOnlyInitCode

	let OverlayDescVec = Allocate(CZ, lODV)
	OverlayScan(lv CFA>>CFA.fp, OverlayDescVec, lODV,
			lv CFA>>CFA.fa)
	OverlayAreaSize = MaxOverlaySize()

	let BQ = Allocate(CZ, size QS/16)
	INITQ(BQ)

	ProcessUserCm(BQ)

	userParamsVec = Allocate(CZ, lUserParams+1)

	FullDspLine = dsp>>DS.fdcb>>DCB.height*2*WordsPerScanLine
	SpaceAbove = NewFakeDisplayStream(10)
	SpaceBelow = NewFakeDisplayStream(10)
	TIMESTR1 = NewDisplayStream(1, 0)
	TIMESTR2 = NewDisplayStream(1, 0)
	DiskInfo = NewDisplayStream(1, 0)
	UserLineEnds = Allocate(CZ, UserLines)
	USERSTR = NewDisplayStream(UserLines, (UserLines-1)*FullDspLine)

	[   let dcb = @DisplayHead
	    until dcb eq 0 do
		[
		dcb>>DCB.background = screenColor
		dcb = dcb>>DCB.next
		]
	]

	ShowDisplayStream(SpaceAbove)
	ShowDisplayStream(TIMESTR2, 0, SpaceAbove)
	ShowDisplayStream(DiskInfo, 0, TIMESTR2)
	ShowDisplayStream(SpaceBelow, 0, DiskInfo)
	ShowDisplayStream(USERSTR, 0, SpaceBelow)

	TIMESTR1>>DS.fdcb>>DCB.next = TIMESTR2>>DS.fdcb>>DCB.next
	PreTimeDcb = FindPreviousDcb(TIMESTR2)

	OldSysErr = @lvSysErr
	@lvSysErr = ExecSysErr
	OldUserFinishProc = @lvUserFinishProc
	@lvUserFinishProc = InCaseOfDemise

	DefaultScroll = USERSTR>>DS.scroll
	USERSTR>>DS.scroll = UserScroll

	DIRSTATE = EMPTY

	SYSTEMDIR = OpenFile("SysDir", ksTypeReadOnly,
		charItem, 0, fpSysDir)

	PrintDiskInformation(DiskInfo)

	RemCm = OpenFile("REM.CM", ksTypeReadWrite,
				charItem, 0, fpRemCm)
	STREAMTOQR(RemCm, BQ)
	Resets(RemCm)
	TruncateDiskStream(RemCm)
	CleanupDiskStream(RemCm)

	ComCm = 0

	resultis BQ
	]


and NewDisplayStream(NLines, BlockSize) = valof

	[ let AreaSize = BlockSize+FullDspLine+
			NLines*lDCB

	let Area = Allocate(CZ, AreaSize, false, true) // even

	let DS = CreateDisplayStream(NLines, Area,
				AreaSize, 0, WordsPerScanLine,
				DSnone, CZ)

	for i = 1 to NLines do
		Puts(DS, $*N)

	let dcb = DS>>DS.fdcb
	until dcb eq 0 do
	    [
	    dcb>>DCB.background = screenColor
	    dcb = dcb>>DCB.next
	    ]
	resultis DS
	]


and NewFakeDisplayStream(NScanLines) = valof

	[
	let ds = Allocate(CZ, lDCB+2, false, true) // even
	let dcb = ds+2
	ds!0, ds!1 = dcb, dcb
	Zero(dcb,lDCB)
	dcb>>DCB.height = NScanLines/2
	dcb>>DCB.background = screenColor
	resultis ds
	]


and FindPreviousDcb(ds) = valof

	[ let prev = DisplayHead
	let firstDcb = ds>>DS.fdcb
	while prev>>DCB.next ne firstDcb do
		prev = prev>>DCB.next
	resultis prev
	]



and MaxOverlaySize() = valof

	[ static [ MaxPages ]

	let CheckMorePages(od) be
		[ let CurPages = OverlayNpages(od)
		if CurPages gr MaxPages then
			MaxPages = CurPages
		]

	MaxPages = 0
	GenerateOverlays(CheckMorePages)
	resultis MaxPages lshift sysDisk>>DSK.lnPageSize
	]


and ProcessUserCm(Q) be

	[
	ShouldSetTime = ThisEventExists("eventBooted", false)
	if ClockIsWrong() then
		[
		// AddEvent(eventClockWrong, 0)
		ShouldSetTime = true
		ClockWrong = true
		]
	let UserCm = OpenFile("User.Cm", ksTypeReadOnly,
			charItem, 0, fpUserCm)
	if UserCm eq 0 then return

	let InExec = false
	let InDisplay = false
	let InScreen = false
	let InTimeOut = false
	let Enabled = false
	until Endofs(UserCm) do
		[ let String = vec 129
		switchon ReadUserCmItem(UserCm, String) into
			[ case $E: break

			case $N:
				if InExec then break
				InExec = (CompareStrings(
					String, "EXECUTIVE") eq 0)
				Enabled = false
				endcase

			case $L:
				unless InExec do endcase
				if CompareStrings(String, "DISPLAYLINES") eq 0 then
					[ InDisplay = true; endcase ]
				if CompareStrings(String, "SCREEN") eq 0 then
					[ InScreen = true; endcase ]
				if CompareStrings(String, "EVENTABOUTTODIE") eq 0 then
					[ InTimeOut = true; endcase ]
				Enabled = ThisEventExists(String)
				endcase

			case $P:
				if InDisplay then
				  [
				  UserLines = GetNumber(String, UserLines)
				  InDisplay = false
				  endcase
				  ]
				if InScreen then
				  [
				  if CompareStrings(String, "BLACK") eq 0
				    then screenColor = screenBlack;
				  InScreen = false
				  endcase
				  ]
				if InTimeOut then
				  [
				  if HasCommands(String) then
				    [ let n = String>>STRING.length/2+1
				    TimeOutCommand = Allocate(CZ,n)
				    MoveBlock(TimeOutCommand,String,n)
				    ]
				  InTimeOut = false
				  endcase
				  ]
				unless Enabled do endcase
				if HasCommands(String) then ClockWrong = true
				STRINGTOQR(String, Q)
				PUTQR(Q, $*N)

			default:
				InDisplay = false;
				InScreen = false;
				Enabled = false
			]
		]

	Closes(UserCm)
	]


and HasCommands(s) = valof
	[
	if s>>STRING.length eq 0 then resultis false
 	for i = 1 to s>>STRING.length do
	  switchon s>>STRING.char↑i into
	    [
	    case $*S: case $*T: endcase;
	    case $/: resultis false;
	    default: resultis true 
	    ]
	]


and GetNumber(s, def) = valof
	[ // convert s to a decimal number
	let v = 0
	let usedefault = true
	let i = 1
	let len = s>>STRING.length
	while i le len & s>>STRING.char↑i ge $0 & s>>STRING.char↑i le $9 do
		[ v = v*10 + s>>STRING.char↑i-$0;
		  i = i+1
		  usedefault = false
		]
	resultis usedefault ? def, v
	]


//and AddEvent(type, bodyLen, body) be
//
//	[ // if no identical event exists in the event vector
//	// and there is room, add an event.
//
//	let eve = EventVector
//	until eve!0 eq 0 do
//		[ if valof
//			[ if eve>>EVM.type ne type
//				then resultis false
//
//			if eve>>EVM.length ne bodyLen+1
//				then resultis false
//
//			for i=1 to bodyLen do
//				if eve!i ne body!(i-1)
//					then resultis false
//			resultis true
//			] then return
//
//		eve = eve+eve>>EVM.length
//		]
//
//	if eve+bodyLen+1 ge EventVector+(EventVector!-1)
//		then return
//
//	eve>>EVM.type = type
//	eve>>EVM.length = bodyLen+1
//	MoveBlock(eve+1, body, bodyLen)
//	eve!(bodyLen+1) = 0
//	]


and ThisEventExists(String, deletIt; numargs na) = valof

	[ if na ls 2 then deletIt = true
	let Result = false
	let EventPtr = EventVector
	let CopyPtr = EventPtr
	let s = vec 20
	let unknown = CompareStrings(String, "eventUnknown") eq 0
	while EventPtr>>EVM.length gr 0 do
		[ let Length = EventPtr>>EVM.length
		let eventName = selecton EventPtr>>EVM.type into
				[ case eventBooted: "eventBooted"
				case eventAboutToDie: "eventAboutToDie"
				case eventInstall: "eventInstall"
				case eventRFC: "eventRFC"
				case eventExecuteCode: "eventExecuteCode"
				default: MakeEventName(s)
				]
		test CompareStrings(String, eventName) eq 0 % unknown
		  ifso Result = true
		  ifnot	if deletIt then
			[ MoveBlock(CopyPtr, EventPtr, EventPtr>>EVM.length)
			CopyPtr = CopyPtr+Length
			]

		EventPtr = EventPtr+Length
		]
	if deletIt then CopyPtr!0 = 0
	resultis Result
	]


and CompareStrings(S1, S2) = valof

	[ let lS1 = S1>>STRING.length
	let lS2 = S2>>STRING.length
	let lC = (lS1 ls lS2)? lS1, lS2

	for i=1 to lC do
		[
		let c1 = Capitalize(S1>>STRING.char↑i)
		let c2 = Capitalize(S2>>STRING.char↑i)
		if c1 ne c2 then
			resultis (c1 gr c2) ? 1, -1
		]
	resultis (lS1 eq lS2)? 0, ((lS1 gr lS2)? 1, -1)
	]


and MakeEventName(s, enum) be

	[
	let event = "event"
	let append(s,c) be
		[ let l = s>>STRING.length+1
		s>>STRING.char↑l = c
		s>>STRING.length = l
		]
	let appendnumber(s,n) be
		[ let r = n rem 10
		if n/10 ne 0 then appendnumber(s,n/10)
		append(s,r+$0)
		]
	s>>STRING.length = 0
	for i = 1 to event>>STRING.length do
		 append(s,event>>STRING.char↑i)
	appendnumber(s,enum)
	]


and PrintDiskInformation(Stream) be

	[ structure JUNTADL:
		[ next word 1
		leaderVirtualDa word 1
		stuff word 3
		version word
		serialNumber @SN
		]

	let FP = vec lFP
	let Disk = vec 256

	BfsMakeFpFromLabel(FP, juntaTable)

	let Da = juntaTable>>JUNTADL.leaderVirtualDa
	FP>>FP.leaderVirtualDa = Da
	BootFileIllegal = false
	let BootFile = OpenFile(0, 0, charItem, 0, FP,
		BootFileDoesntExist, 0)

	test BootFileIllegal % (BootFile eq 0)

	ifso	[ FORMAT(Disk, "OS Not Installed")
		]

	ifnot	[ SetFilePos(BootFile, 0, 512)

		let Len = Gets(BootFile)
		for i=1 to Len do
			Gets(BootFile)

		if (Len&1) eq 0 then Gets(BootFile)

		let Len = Gets(BootFile)
		Disk>>STRING.length = Len
		for i=1 to Len do
			Disk>>STRING.char↑i = Gets(BootFile)

		Closes(BootFile)
		]

	let len = Disk>>STRING.length
	DiskName = Allocate(CZ, (len+2)/2)
	MoveBlock(DiskName, Disk, (len+2)/2);
	if (SerialNumber&#377) eq #377 then NetNumber = 0
	ShowDiskInfo(Stream)
	MAKETIMELINE()
	]
	

and BootFileDoesntExist(X, Y, Z) be

	[ BootFileIllegal = true
	]


and FixupCursor() be

	[ MoveBlock(#431, (table [
		#100000; #140000; #160000; #170000; #174000;
		#176000; #177000; #170000; #154000; #114000;
		#006000; #006000; #003000; #003000; #001400;
		#001400 ]), 16)
	]


and ClockIsWrong() = valof

	[
	let TIME = vec lenUTV
	UNPACKDT(0, TIME)
	resultis (TIME>>UTV.year ls 1983) % (TIME>>UTV.year gr 1990)
	]