//Mmprgn.bcpl
//	Last edited: 20 August 1981

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

external [
// OS
	Resets; Puts; Closes; DoubleAdd; SetBlock; Zero

// MIDAS
	MidasSwat; Initialized

// MASM
	Wss; @WssCSS; PutsCSS; RepPuts; StrSize; DummyCall
	@MBlock; VUsc; MoveLongField; SelfRel

// MOVERLAY
	OverlayZone

// MIOC
	DWns; Wns; SimpleTexttoDVec; GenlTexttoDVec; DataToStream

// MSYM
	EvalAText; SearchBlocks

// MTXTBUF
	InputTextBuffer; InputStream

// MDISP
	Blink; DisplayOff

// MRGN
	RegionTable

// MMENU
	CreateAction; MarkMenus; FormMenu; LookUpMenu
	@WsMarkA; WssMAct; @ItemV; ItemStream

// MCMD
	WnsCSS; CmdCommentStream; ErrorAbort

// xxACTIONS
	BugAddrAct; BugValAct; Plus1Act; Minus1Act; ColumnAct
	OctAct; DecAct; HexAct; SearchAct; SymbolicAct; NumericAct
	BadAText; @LongOne

// Machine interface
	MGetRegData; MGetMemData; MPutRegData; MPutMemData; HWEveryTime
	@REGFORMS; @REGWID; @REGCON; AltRForms; AltRInput; @ScreenWidth
	@MEMFORMS; @MEMWID; @MEMCON; AltMForms; AltMInput; @MEMNAM; @MEMLEN
	HWShowAddr; HWAlwaysUpdate; @VirtualP

// Defined here
	UpdateMPDValues; MPDdeSelect; ShowAddr; RDatatoCSS; MDatatoCSS
	GetRadix; BadAltIn; MPDMChange

// Defined here for init and MMPRGNOV only
	MPDs; @MPDVVec; MPDEveryTime; FirstMPD; LastMPD
	SetAddr; SetValue; StepAddr; FormMPDmenu; FixForm
]


static
[	MPDs; @MPDVVec; FirstMPD = 0; LastMPD
]

//HOW NAME-VALUE MENU UPDATING WORKS

//SetAddr and StepAddr actions put new items on the display, obtaining
//the value by calling MGetRegData or MGetMemData (except during Init0
//MGetxx are not called).  These and actions which modify display mode
//or menu for an MPD set RebuildText true.

//Subsequently, UpdateMPDValues() updates all values displayed.  If an MPD
//menu changes because a new value is different, RebuildText is set true
//in MPD.  UpdateMPDValues should be called by machine-dependent Init2,
//after it is prepared to deliver values, and at other times when displayed
//values might be wrong, such as after step or go.

//DriverLoop calls MPDEveryTime() each time around to rebuild any MPD
//menus which have changed.  MPDEveryTime will do this for any MPD menu
//with RebuiltText true.  Subsequently, DriverLoop calls UpdateDisplay()
//to build bit buffers.

//When command files are in execution, MPDEveryTime is not called unless
//the display is on.  When overlays are loaded the MPD display area is
//blank; MPDEveryTime checks for this case and defers screen rebuilding
//until the display is rebuilt by ReUseDispSpace().


//Update all values that are on the display, setting the RebuildText
//flag in the MPD structure, if display update required.
let UpdateMPDValues(AlwaysOnly; numargs NA) be
[	if NA eq 0 then AlwaysOnly = false
	let Val = vec ValSize
	for Rn = FirstMPD to LastMPD do
	[ let MPD = RegionTable!Rn
	  let MenuMode = MPD>>MPD.MDFS.MenuMode
	  if MenuMode ne 0 do	//If not idle...
	  [ if AlwaysOnly then unless MPD>>MPD.AlwaysUpdate ne 0 do loop
	    let V = lv MPD>>MPD.Value
	    MBlock(Val,V,ValSize)
	    let MGet = MPD>>MPD.AVal.TypeStorage eq RegTypeStorage ?
		MGetRegData,MGetMemData
//Make sure that the "*" or "&" preliminary character remains for
//AlwaysOnly updates.
//The MGet procedure returns false iff the hardware cannot deliver the
//value now for some reason (e.g., machine running).
	    let Prelim = 0
	    test MGet(MPD>>MPD.AVal.X,V,lv MPD>>MPD.AVal.Addr,
		MPD>>MPD.Extension)
	    ifso
	    [ if VUsc(Val,V,ValSize) ne 0 then
	      [ Prelim = 2
	        if MenuMode eq StandardMenu then MPD>>MPD.RebuildText = 1
	      ]
	    ]
	    ifnot Prelim = 1
	    if Prelim ne MPD>>MPD.Prelim do
	    [ if AlwaysOnly & (Prelim < 2) &
		(MPD>>MPD.Prelim ge 2) then loop
	      MPD>>MPD.RebuildText = 1
	      MPD>>MPD.Prelim = Prelim
	    ]
	  ]
	]
]


and MPDEveryTime(nil,BuildingDisplay; numargs NA) be
[	if (NA le 1) & (OverlayZone ne 0) then return
	HWEveryTime()
	for Rn = FirstMPD to LastMPD do
	[ let MPD = RegionTable!Rn
	  if MPD>>MPD.RebuildText ne 0 do
	  [ FormMenu(MPD,FormMPDmenu); MPD>>MPD.RebuildText = 0
	  ]
	]
]

and WssFA(Action,BlankSpace) be
[	Wss(ItemStream,Action>>Action.Name)
	RepPuts(ItemStream,$ ,BlankSpace); MarkMenus(Action)
]


and FormMPDmenu(S,MPD) be
[	let BlankSpace = MPD>>MPD.TextSpace
	let X = MPD>>MPD.AVal.X
	let Radix = GetRadix(MPD)
	let DisplayMode = MPD>>MPD.AVal.DisplayMode
	let Action = 0
	switchon MPD>>MPD.MDFS.MenuMode into
	[
case 0:			//Idle
	  Puts(S,$ ); MarkMenus(0); RepPuts(S,$ ,BlankSpace-1)
	  MarkMenus(BugAddrAct); return

case RadixMenu:		//Two of "Oct", "Dec", and "Hex"
	  WsMarkA((Radix eq 8 ? DecAct,OctAct))
	  WssFA((Radix eq 16 ? DecAct,HexAct),BlankSpace-7); return

case DisplayModeMenu:	//Two of "Num", "Search", and "Sym"
	  WsMarkA((DisplayMode eq 0 ? SearchAct,NumericAct))
	  WssFA((DisplayMode eq 2 ? SearchAct,SymbolicAct),
		BlankSpace-(DisplayMode eq 1 ? 7,10))
	  return

case FillCMenu:		//"FillC"
	  WssFA(ColumnAct,BlankSpace-5); return

case AddressMenu:	//"A+1","A-1"
	  if MPD>>MPD.AVal.TypeStorage eq MemTypeStorage do
	  [ let Last = vec 1; Last!0 = -1; Last!1 = -1
	    DoubleAdd(Last,MEMLEN+X+X)
	    if VUsc(Last,lv MPD>>MPD.AVal.Addr,2) > 0 do
	    [ BlankSpace = BlankSpace-3; Action = Plus1Act
	    ]
	    if VUsc(lv MPD>>MPD.AVal.Addr,LongOne,2) ge 0 do
	    [ if Action ne 0 then WsMarkA(Action)
	      BlankSpace = BlankSpace-4; Action = Minus1Act
	    ]
	    WssFA(Action,BlankSpace); return
	  ]

default:  endcase	//StandardMenu
	]

//Normal picture--print "~" if value unknown else "*" if different
//from last time.
	Puts(S,table [ $ ; $~; $**; $& ] ! (MPD>>MPD.Prelim))
	MarkMenus(0)
	BlankSpace = BlankSpace-1
//Show name
	if MPD>>MPD.NoName eq 0 then Wss(S,lv MPD>>MPD.AVal.SName)
	let Form,Width = nil,nil
	test MPD>>MPD.AVal.TypeStorage eq RegTypeStorage
	ifso
	[ Form,Width = REGFORMS!X,REGWID!X
	]
//Show offset for memory names and addresses
//**Would like to allow separate address and value radices here
	ifnot
	[ if MPD>>MPD.NoName eq 0 do
	  [ let ARadix = nil
	    test MPD>>MPD.AVal.Sign eq 0
	    ifso	//Unsigned
	    [ Puts(S,$ ); ARadix = Radix	//Unsigned
	    ]
	    ifnot ARadix = -Radix		//Signed
	    DWns(S,lv MPD>>MPD.AVal.Offset,32,0,ARadix,1,0)
	  ]
	  Form,Width = MEMFORMS!X,MEMWID!X
	]
//Select correct form for items with extensions
	Form = FixForm(Form,MPD>>MPD.Extension)
//Show value
	Resets(MPDs)
	let AVec,Value = vec 1,lv MPD>>MPD.Value
	switchon DisplayMode into
	[
case 2:   (rv Form!-2)(MPDs,X,Value,lv MPD>>MPD.AVal.Addr); endcase
//Convert SearchBlocks mode to numeric when not in Virtual mode.
case 1:	  if VirtualP do
	  [ Zero(AVec,2); MoveLongField(Value,0,Width,AVec,32-Width)
	    SearchBlocks(MPDs,Form!-1,AVec,-1,0,Radix); endcase
	  ]
default:  DataToStream(MPDs,Form,Width,Value,Radix)
	  endcase
	]

//If the name and value do not fill the text space available, the
//code below leaves a null zone no bigger than 2 chars between them.
//If the name is less than 5 characters, extra blanks extend the name
//up to 5 characters.  Any more blanks beyond that extend the value.
//If the value overlaps the name, then the name is truncated except that
//one character of name is always printed (unless the NoName flag is set,
//in which case no name characters are ever printed).

	let ALim = ItemV!0		//Size of name
	BlankSpace = BlankSpace - ALim - MPDVVec!0
	let VStart = 1
//If overlap, flush any leading 0's or blanks in the value.
	while (BlankSpace < 0) & (VStart < MPDVVec!0) &
		((MPDVVec!VStart eq $*S) % (MPDVVec!VStart eq $0)) do
	[ VStart = VStart+1; BlankSpace = BlankSpace+1
	]
	if BlankSpace < 0 do		//Overlap?
	[ ALim = ALim + BlankSpace	//Then truncate name
	  BlankSpace = 0
	  if ALim < 0 do		//Name completely overlapped?
	  [ VStart = 1 - ALim; ALim = 0
	  ]
	]
	if MPD>>MPD.NoName eq 0 do	//Extend name up to 5 chars
	[ if ALim le 0 do
	  [ ALim = 1; VStart = VStart+1
	  ]
	  while (BlankSpace > 2) & (ALim < 5) do
	  [ Puts(S,$ ); BlankSpace = BlankSpace-1; ALim = ALim+1
	  ]
	  ItemV!0 = ALim; MarkMenus(BugAddrAct)
	  if BlankSpace > 0 do		//But leave gap if possible
					//2 char gap if value big enough
	  [ Puts(S,$ ); BlankSpace = BlankSpace-1
	    if (BlankSpace > 0) & ((MPDVVec!0 + BlankSpace) ge 5) do
	    [ Puts(S,$ ); BlankSpace = BlankSpace-1
	    ]
	    MarkMenus(0)
	  ]
	]
	RepPuts(S,$ ,BlankSpace)	//Rest of blanks extend value
	for I = VStart to MPDVVec!0 do Puts(S,MPDVVec!I)
	MarkMenus(BugValAct)
]


//Called from MenuMChange
//Since the buttons may not go down and up concurrently, show the menu
//appropriate for MBunion until all mouse buttons go up and then switch
//to the menu for all mouse buttons up.  When the mouse buttons go up,
//DoAction will be called before the menu change occurs.
and MPDMChange(lvTable,MPD,MBunion,MB) be
[	if MB eq 0 then MBunion = 0
	let MTable = SelfRel(rv lvTable)
	let NewMode = MTable!MBunion
	let MenuMode = MPD>>MPD.MDFS.MenuMode
	if MenuMode ne 0 then if MenuMode ne NewMode do
	[ MPD>>MPD.MDFS.MenuMode = NewMode; MPD>>MPD.RebuildText = true
	]
]


and MPDdeSelect(MPD) be
[	if MPD>>MPD.MDFS.MenuMode > StandardMenu do
	[ MPD>>MPD.MDFS.MenuMode = StandardMenu
	  MPD>>MPD.RebuildText = true
	]
]

and SetValue(nil,MBunion,MPD) be
[	let X = MPD>>MPD.AVal.X			//RegX or MemX
//A little tricky:  Some methods of setting the value modify the existing
//value, so the call to TextToData below must pass the existing value as an
//argument.  However, cannot pass lv MPD>>MPD.Value directly because a
//read-only register's current value will be smashed by TextToData prior
//to the call on MPutMemData.  Hence, copy current value into VValue first.
	let VValue = vec ValSize
	MBlock(VValue,lv MPD>>MPD.Value,ValSize)
	let Addr = lv MPD>>MPD.AVal.Addr
	let Con,Form,Width,AltIn,AltOut,MPut = nil,nil,nil,nil,nil,nil
	test MPD>>MPD.AVal.TypeStorage eq RegTypeStorage
	ifso
	[ Form,Width = REGFORMS!X,REGWID!X
	  AltIn,AltOut = AltRInput,AltRForms
	  Con,MPut,Addr = REGCON,MPutRegData,0
	]
	ifnot
	[ Form,Width = MEMFORMS!X,MEMWID!X
	  AltIn,AltOut = AltMInput,AltMForms
	  Con,MPut = MEMCON,MPutMemData
	]
	let Radix,Extension = GetRadix(MPD),MPD>>MPD.Extension
	Form = FixForm(Form,Extension)
	switchon MBunion into
	[
case TopButton:					//Value←InputTextBuffer
	  unless (Form eq 0 ?
		SimpleTexttoDVec(InputTextBuffer,Width,VValue,Radix),
		GenlTexttoDVec(InputTextBuffer,Form,VValue,Radix)) do
	  [ MBlock(VValue,lv MPD>>MPD.Value,ValSize)
	    DummyCall(AltIn!X,X,Addr,VValue,InputTextBuffer,Radix)
	  ]
	  MPut(X,VValue,Addr,Extension)
//Pretty-print the new value when appropriate.
	  if DisplayOff % (MPD>>MPD.Prelim eq 1) %
		((Con+X)>>MRType.AutoPrettyPrint eq 0) then return
//**The Extension is needed on Dorado Midas for PIPE and ROW.
case MiddleButton:				//Alternate printout
	  DummyCall(AltOut!X,X,lv MPD>>MPD.Value,Addr,
		Radix+(Extension lshift 8))
	  return
case BottomButton:				//Append to InputTextBuffer
	  DataToStream(InputStream,Form,Width,VValue,Radix); return
	]
]


and FixForm(Form,Extension) = valof
[	if Form eq 0 then resultis 0
	if Form!0 ge 0 then resultis Form
	if Extension ge (-Form!0) then MidasSwat(BadExtension)
	resultis SelfRel(Form+Extension+1)
]

//Alternate input procedure for regs/mems that don't have one
and BadAltIn(TV,DVec,Radix) be ErrorAbort()


//Pretty-print procedures for registers and memories that don't have
//anything special implemented.
and RDatatoCSS(RegX,DVec,AVec,ExtRadix) be
	DataToStream(CmdCommentStream,FixForm(REGFORMS!RegX,ExtRadix<<lh),
		REGWID!RegX,DVec,ExtRadix<<rh)


and MDatatoCSS(MemX,DVec,AVec,ExtRadix) be
	DataToStream(CmdCommentStream,FixForm(MEMFORMS!MemX,ExtRadix<<lh),
		MEMWID!MemX,DVec,ExtRadix<<rh)

and SetAddr(nil,MBunion,MPD) be
[	let X = 1
//Note that the alternate menu actions are handled by MPDMChange, not here
	if MPD>>MPD.MDFS.MenuMode ne 0 do
	[ if (MBunion & MiddleButton) ne 0 do
	  [ ShowAddr(lv MPD>>MPD.AVal); return
	  ]
	]
	let Letter,L = MPD>>MPD.MDFS.Letter,MPD>>MPD.MDFS.LineN
	test InputTextBuffer!0 eq 0
	ifso
	[ MPD>>MPD.MDFS.MenuMode = 0; MPD>>MPD.RebuildText = true
	]
	ifnot
	[ let AVal = vec size AVal/16
	  unless EvalAText(InputTextBuffer,lv X,AVal,0) do ErrorAbort()
	  let CON,MGet,Form,X = nil,nil,nil,AVal>>AVal.X
	  test AVal>>AVal.TypeStorage eq MemTypeStorage
	  ifso
	  [ CON,MGet,Form = MEMCON!X,MGetMemData,MEMFORMS!X
	  ]
	  ifnot
	  [ CON,MGet,Form = REGCON!X,MGetRegData,REGFORMS!X
	  ]
	  let LastExtension = (Form ne 0) & (Form!0 < 0) ? -1-Form!0,0
//Fail unless all extensions fit in column
	  unless LookUpMenu(Letter,L+LastExtension) do
		ErrorAbort("Extensions won't fit")
	  AVal>>AVal.DisplayMode = CON<<MRType.DefMode
	  AVal>>AVal.Radix = CON<<MRType.DefRadix
	  let Extension = 0
	  [ MBlock(lv MPD>>MPD.AVal,AVal,size AVal/16)
	    MPD>>MPD.AlwaysUpdate =
		HWAlwaysUpdate(CON,X,lv MPD>>MPD.AVal.Addr)
	    MPD>>MPD.MDFS.MenuMode = StandardMenu
//The extension kludge allows items occupying several consecutive lines
//in a column to be put on/taken off the display as a unit.  However,
//MGet/MPut procedures must deal with the component on each line
//separately.
	    MPD>>MPD.Extension = Extension
	    MPD>>MPD.NoName = Extension ne 0
	    MPD>>MPD.Prelim = Initialized ?
		(MGet(X,lv MPD>>MPD.Value,lv MPD>>MPD.AVal.Addr,
			Extension) ? 0,1),1
	    MPD>>MPD.RebuildText = true
	    if Extension eq LastExtension then break
	    Extension = Extension+1
	    L = L+1
	    MPD = LookUpMenu(Letter,L)
	    if MPD eq 0 then return
	  ] repeat
	]
//Flush extensions of the last item overwritten.
	[ L = L+1
	  MPD = LookUpMenu(Letter,L)
	  if MPD eq 0 then return
	  if MPD>>MPD.Extension eq 0 then return
	  MPD>>MPD.MDFS.MenuMode = 0
	  MPD>>MPD.RebuildText = true
	] repeat
]

//The +1 and -1 menu items only come up when they are legal, but
//error checks needed for command files.
and StepAddr(lvTable,MBUnion,MPD) be
[	if (MPD>>MPD.MDFS.MenuMode ne 0) &
	  (MPD>>MPD.AVal.TypeStorage eq MemTypeStorage) &
	  (MPD>>MPD.Extension eq 0) do
	[ let AVec,DVec,X = vec 1,vec ValSize,MPD>>MPD.AVal.X
	  MBlock(AVec,lv MPD>>MPD.AVal.Addr,2)
	  DoubleAdd(AVec,(lvTable eq 0 ? LongOne,(rv lvTable)+2))
//Show new address symbolically if possible
	  Resets(InputStream)
	  SearchBlocks(InputStream,X,AVec,-1,true,GetRadix(MPD))
//Update the MPD structure for the new item
	  SetAddr(nil,TopButton,MPD)
//Prettyprint its value if the display is on and the value is ok
	  if (not DisplayOff) & (lvTable ne 0) & (MPD>>MPD.Prelim ne 1) &
		((MEMCON+X)>>MRType.AutoPrettyPrint ne 0) then
		SetValue(nil,MiddleButton,MPD)
	  return
	]
	ErrorAbort(BadAText) 
]


and GetRadix(MPD) = table [ 8; 10; 16; 8 ] ! (MPD>>MPD.AVal.Radix)


and ShowAddr(AVal) be
[	let X = AVal>>AVal.X
	test AVal>>AVal.TypeStorage eq RegTypeStorage
	ifso
	[ WssCSS("Register "); WnsCSS(X)
	]
	ifnot
	[ if SearchBlocks(CmdCommentStream,X,lv AVal>>AVal.Addr) do
	  [ WssCSS(" = "); WssCSS(MEMNAM!X)
	    PutsCSS($ ); DWns(CmdCommentStream,lv AVal>>AVal.Addr)
	  ]
//HWShowAddr is called to print things such as the cache row and map
//entry corresponding to a particular VM address on Dorado.
	  HWShowAddr(X,lv AVal>>AVal.Addr)
	]
]