// MINIT1.BCPL	2nd init 23 June 1983

get "mdecl.d"
get "mcommon.d"
get "streams.d"

external [
// OS
	CallSwat; Noop; Zero; SetBlock; Dvec

// MINIT0
	Init0B; @MBlock; RelocTable; Storage; StateBlock; StatePtr
	FirstStatic; LastStatic; ProgramAct; ReadCAct

// MIDAS
	MidasSwat; ElapsedTime; TimeMSYM; TimeInit1; StateBlockSize

// MASM
	Resets; Wss; PutTVs; ResetTVs; PutTxts; ResetTxts; @BlockTable
	GetStorage

// MSYM
	@HeadBlock

// MSYMOV
	UpdateRcd; BlockUpdateRcd; MakeNewBlock; InitSymBlock
	@LastBlockAddr; @NextM; @LastM2; @LastM1

// MOVERLAY
	SwappedOut

// MRGN
	AddToEveryTimeList; EveryTimeP; EveryTimeA; ControlV
	RegionTable; NRegions

// MMPRGN
	MPDEveryTime; FirstMPD; LastMPD

// MMENU
	MenuBlock; @CurrentMDFS; FormMenu; EscMDFS

// MCMD
	CmdMDFS; SavedLoadText; NPrograms; NReadCFiles

//MDEBUGASM
	NPatterns

// xxACTIONS
	ActionPtr; HWCFActions; NHWCFActions

// Machine dependent
	@ScreenHeight; @ScreenWidth; InitMPInterface; NOtherTests
	@MEMWID; @MEMCON; @MEMNAM; @NMEMS
	@REGWID; @REGCON; @REGNAM; @NREGS

// Defined here
	Init1; NewRegion; NewMPDispBlock; MakeTVS; MakeDisplayLine
	GetZStorage; GetHStorage; SaveStatics
]

manifest [
	MaxItemsInCmdMenu = 82
]

let Init1(TempStorage) be
[
//Copy relocation information for initialization code into vec because
//it gets overwritten by GetStorage.
	let RelocInfo = RelocTable!0+RelocTable!0+1
	Dvec(Init1,lv RelocInfo)
	MBlock(RelocInfo,RelocTable,RelocTable!0+RelocTable!0+1)

	Init0B(TempStorage)	//Returns only on Midas/I

//MRGN
	EveryTimeP = GetStorage(MaxEveryTime)
	EveryTimeA = GetStorage(MaxEveryTime)
	SetBlock(EveryTimeP,Noop,MaxEveryTime)

//MSYM
	BlockTable = GetZStorage((MaxInCoreBlocks*(size BT/16))+1)
	let CB = MakeNewBlock(NPagesPerHeadBlock,SymKind,0)
	HeadBlock = InitSymBlock(CB,NPagesPerHeadBlock*PageSize)
	BlockTable!0 = -1	//So that HeadBlock isn't in BlockTable
	CB = MakeNewBlock(NPagesPerStandardBlock,SymKind,0)
	let CurrentBlock = InitSymBlock(CB,NPagesPerStandardBlock*PageSize)
	LastBlockAddr = CB>>BT.BlockAddr
//Enter null & max strings in symtab to avoid end checks
	unless BlockUpdateRcd(HeadBlock,-(size BH/16 - 1), "",
		lv LastBlockAddr, 1)
	  & BlockUpdateRcd(CurrentBlock,-(size BH/16 - 1), "",
		table [ 0 ] , 1)
	  & BlockUpdateRcd(CurrentBlock,-(size BH/16),
		table [ 1577B; 77577B ] ,table [ 0 ] , 1)
	  do MidasSwat(MSymInitBug)
	ElapsedTime(lv TimeMSYM)

//MMENU
	MenuBlock = GetZStorage(MaxMenus)

// Following must be last items before call on DriverLoop
// Put register and memory definitions into symbol table
	let Body = vec (size Symb/16)
	Body>>Symb.M.Type = MemSymb
	for MemX = 0 to NMEMS-1 do
	[ if (MEMCON+MemX)>>MRType.Defined eq 0 then loop
	  Body>>Symb.M.X = MemX
	  if MEMWID!MemX > (ValSize*16) then MidasSwat(VSEmsg,MEMNAM!MemX)
	  UpdateRcd(MEMNAM!MemX,Body,size Symb.M/16)
	]
	Body>>Symb.R.Type = RegSymb
	for RegX = 0 to NREGS-1 do
	[ if (REGCON+RegX)>>MRType.Defined eq 0 then loop
	  Body>>Symb.R.X = RegX
	  if REGWID!RegX > (ValSize*16) then MidasSwat(VSEmsg,REGNAM!RegX)
	  UpdateRcd(REGNAM!RegX,Body,size Symb.R/16)
	]
//Machine dependent
	InitMPInterface()
//MMPRGN
	AddToEveryTimeList(MPDEveryTime,nil)

//MCMD
	let rcx,H,W = 0,3,ScreenWidth-1
	SavedLoadText = GetZStorage(W+1)
	CmdMDFS = MakeMenuRegion(size MDFS/16,$X,-1,ScreenHeight-5,
		0,H,W,MaxItemsInCmdMenu)
	EscMDFS = CmdMDFS

//MINIT2 will make actions out of NPrograms and NReadCFiles.
//Check that RdCmds menu names don't overflow menu.
	let TLines,TCount,TOvf = 1,6-ScreenWidth,0	//6 for "Abort "
	for I = 0 to NReadCFiles-1 do
	[ CountAStr((ReadCAct!I)>>lh,lv TLines,lv TCount,lv TOvf)
	]
	let StrP = HWCFActions
	for I = 0 to NHWCFActions-1 do
	[ CountAStr((StrP>>Action.Name)>>lh,lv TLines,lv TCount)
	  StrP = StrP+(size Action/16)
	]
	if TLines > 3 then MidasSwat(TooManyRC,TOvf)

//Check that the RunProg menu names don't overflow menu.
	TLines,TCount,TOvf = 1,6-ScreenWidth,0
	for I = 0 to NPrograms-1 do
	[ CountAStr((ProgramAct!I)>>lh,lv TLines,lv TCount,lv TOvf)
	]
	if TLines > 3 then MidasSwat(TooManyRP,TOvf)

//Assume that the "Test" menu has the largest number of temporary actions
//and require 1 more action slot for safety.  This check is inexact:
//***On Dorado all testable registers are tested by TestAll, but the testable
//***IMBD, MAP, VM, and IFUM memories are not tested by TestAll.
//However, it is inadvisable to swap in the Test overlay which contains the
//tables indicating which registers and memories are testable.
	TCount = ActionPtr+NReadCFiles+NPrograms+NPatterns+NOtherTests+6
	for I = 0 to NREGS-1 do
	[ if (REGCON+I)>>MRType.TestAll ne 0 then TCount = TCount+1
	]
	for I = 0 to NMEMS-1 do
	[ if (MEMCON+I)>>MRType.TestAll ne 0 then TCount = TCount+1
	]
	if TCount ge MaxActions do MidasSwat(TooManyCF,TCount-MaxActions)

//Save page zero statics
Debug4:	SaveStatics(lv BlockTable,lv CurrentMDFS,lv LastBlockAddr,
		lv HeadBlock,lv NextM,lv LastM2,lv LastM1)
	Storage = Init1

//Bind initialization procedures to SwappedOut
	H = RelocInfo+1
	let Lowest = Init1
	for I = 1 to RelocInfo!0 do
	[ if (@H < FirstStatic) % (@H > LastStatic) then CallSwat()
	  if @@H < Lowest then CallSwat()
	  @@H = SwappedOut; H = H+2
	]
	ElapsedTime(lv TimeInit1)
]


and GetHStorage(Size) = valof
[	let Vector = GetStorage(Size+1)
	Vector!0 = Size
	resultis Vector
]


and GetZStorage(Size) = valof
[	let Vector = GetStorage(Size)
	Zero(Vector,Size)
	resultis Vector
]


//For text lines, Rgn, ST, and TV are in sequence; return pointer to TV.
and MakeDisplayLine(lvStream,Line,H,W,rcx) = valof
[	let S = NewRegion((size Rgn/16)+(size ST/16)+W+1,0,
		Line,rcx,H,W,TextRgn)+(size Rgn/16)
	rv lvStream = MakeEmptyTVstream(S,W,PutTxts,ResetTxts)
	resultis S+(size ST/16)
]


and MakeEmptyTVstream(S,Width,PutS,ResetS) = valof
[	SetUpStream(S,S+(size ST/16),Width,CallSwat,CallSwat,PutS,
		ResetS,CallSwat,CallSwat,CallSwat,CallSwat,0,0)
	Resets(S)
	resultis S
]


//For TV streams, ST structure is followed by TV.
and MakeTVS(lvStream,lvVector) be
[	rv lvStream = MakeEmptyTVstream(
		GetStorage((size ST/16)+ScreenWidth+1),
		ScreenWidth,PutTVs,ResetTVs)
	rv lvVector = (rv lvStream)+(size ST/16)
]


and SetUpStream(S,xPar1,xPar2,xClose,xGets,xPuts,xResets,xPutb,
		xError,xEndof,xStateof,xType,xPar3) be
[	S>>ST.par1 = xPar1;	S>>ST.par2 = xPar2
	S>>ST.close = xClose;	S>>ST.gets = xGets
	S>>ST.puts = xPuts;	S>>ST.reset = xResets
	S>>ST.putback = xPutb;	S>>ST.error = xError
	S>>ST.endof = xEndof;	S>>ST.stateof = xStateof
	S>>ST.type = xType;	S>>ST.par3 = xPar3
]


//Fill in alternate words of StateBlock with pointers to page-zero statics
//to be saved.  The values are filled in by SaveState.

and SaveStatics(lv1,lv2,lv3,lv4,lv5,lv6,lv7,lv8,lv9,lv10,
	lv11,lv12,lv13,lv14,lv15,lv16,lv17,lv18,lv19,lv20; numargs NA) be
//Know that BCPL puts the args in sequential order on the stack
[	if NA > 20 then MidasSwat(TMAforSaveStatics)
	while NA > 0 do
	[ NA = NA-1; StateBlock!StatePtr = (lv lv1)!NA
	  StatePtr = StatePtr+2
	]
	if StatePtr > StateBlockSize then MidasSwat(StateBlockTiny)
]

//The MDFS stuff uses the words preceding the RGN structure for TextLines,
//SizeVec, and ProcVec.
//**Note:  It is desirable for the regions on a particular line to be
//allocated in order, so that the searches by DriverLoop() are short
and NewRegion(BlockSize,Offset,rlx,rcx,Height,Width,Type) = valof
[	if NRegions ge MaxNRegions then MidasSwat(TooManyRgns)
	if (rlx+Height > ScreenHeight) %
	  (rcx+Width > ScreenWidth) %
	  (rlx < 0) % (rcx < 0) then MidasSwat(BadNewRegionArgs)
	let R = GetZStorage(BlockSize+Offset)+Offset
	R>>Rgn.aLineX = rlx
	R>>Rgn.aCharX = rcx
	R>>Rgn.Height = Height
	R>>Rgn.Width = Width
	R>>Rgn.Type = Type
	R>>Rgn.DispDirty = 1
	NRegions = NRegions+1
	if NRegions ne 0 do
	[ for I = rlx+1 to rlx+Height do
	  [ if ControlV!I eq 0 then ControlV!I = NRegions
	  ]
	]
	RegionTable!NRegions = R
	resultis R
]


//Menus may be a single letter (A to Z) or a single letter followed
//by a small integer (A0 to E19).  LineN must be -1 if omitted.
//Command menu is "X"
and MakeMenuRegion(Size,Letter,LineN,rlx,rcx,H,W,MaxNItems) = valof
[	let Offset = H+MaxNItems
	Offset = Offset+(Offset rshift 1)
	let S = NewRegion(Size,Offset,rlx,rcx,H,W,MenRgn)	
	S>>MDFS.Letter = Letter
	S>>MDFS.LineN = LineN
	S>>MDFS.ProcNMax = MaxNItems
	S>>MDFS.inLine = 1
//	S>>MDFS.SelectedItem = 0; S>>MDFS.mIn = 0
	let LetterV = Letter-$A
	if LineN ge 0 then LetterV = (LetterV*MaxLineN)+LineN+($Z-$A+1)
	if LetterV ge MaxMenus then MidasSwat(BadMenuName)
	if MenuBlock!LetterV ne 0 then MidasSwat(DuplicateMenuName)
	MenuBlock!LetterV = S
	resultis S
]


//Args are Line = line number (0 to n)
// C = left character (0 to ScreenWidth-1)
// Cnm = command file character identifying region
// W = width in characters (C+W < ScreenWidth, W < 128)
//**Used to set NoName here for Maxc2 STK stuff,but now are using
//**NoName in multi-line items, so no longer works.
and NewMPDispBlock(Line,C,Cnm,W) be
[	unless (C+W) < ScreenWidth do MidasSwat(BadMPDInit)
	let MPD = MakeMenuRegion(size MPD/16,Cnm,Line,Line,C,1,W,5)
	MPD>>MPD.RebuildText = true	//DriverLoop will paint
	MPD>>MPD.TextSpace = W		//This should be checked, not sure
	LastMPD = NRegions
	if FirstMPD eq 0 then FirstMPD = NRegions
]


and CountAStr(StrLen,lvLines,lvCount,lvOvf) be
[	let Count,Lines = rv lvCount,rv lvLines
	Count = Count+StrLen	//Count the string
	if Count > 0 do
	[ rv lvLines,Count = (rv lvLines)+1,StrLen-ScreenWidth
	]
	if rv lvLines > 3 then rv lvOvf = (rv lvOvf) + StrLen
	Count = Count+1		//Count the blank
	if Count > 0 do
	[ rv lvLines,Count = (rv lvLines)+1,1-ScreenWidth
	]
	rv lvCount = Count
	if rv lvLines > 3 then rv lvOvf = (rv lvOvf) + 1
]