//MMPRGNOV.BCPL -- command file Actions in name-value menus
//	Last edited: 3 November 1980

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

external [
// OS
	DoubleAdd; Resets; Puts

// MIDAS
	MidasSwat

// MASM
	ErrorProtect; DummyCall; VUsc; @MBlock; Wss
	@WssCSS; ResetsCSS; ResetsCS1

// MSYM
	EvalAText; SearchBlocks

// MIOC
	SimpleTexttoDVec; GenlTexttoDVec

// MTXTBUF
	InputTextBuffer; InputStream

// MMPRGN
	GetRadix; FormMPDmenu; SetAddr; ShowAddr; FixForm

// MMENU
	SkipCommandCount; FormMenu; LookUpMenu

// MCMD
	ErrorAbort; CFOutStream

// MINIT0
	CmdCS0Vec; CmdCS1Vec

// Machine interface
	MGetRegData; MGetMemData
	@REGFORMS; @REGWID; @REGCON; AltRInput; AltRForms
	@MEMFORMS; @MEMWID; @MEMCON; AltMInput; AltMForms; @MEMLEN; DefRadix

// xxACTIONS
	BadAText; @LongOne

// Defined here for xxACTIONS only
	SkipVEql; SkipVGr; SkipVLs; SkipVGrE; SkipVLsE; SkipVNEql
	ChangeRadix; ShowMode; FillColumn; CmdAddrEq; CmdPrettyPrint
]

let GetVal(MPD) = valof
[	if MPD>>MPD.MDFS.MenuMode eq 0 then ErrorAbort("Menu empty")
	let V1,X = vec ValSize-1,MPD>>MPD.AVal.X
	let Form,Width,AltIn = nil,nil,nil
	let Radix = GetRadix(MPD)
	test MPD>>MPD.AVal.TypeStorage eq RegTypeStorage
	ifso
	[ Form,Width,AltIn = REGFORMS!X,REGWID,AltRInput
	]
	ifnot
	[ Form,Width,AltIn = MEMFORMS!X,MEMWID,AltMInput
	]
	unless (Form eq 0 ?
		SimpleTexttoDVec(InputTextBuffer,Width!X,V1,Radix),
		GenlTexttoDVec(InputTextBuffer,Form,V1,Radix)) do
	[ unless ErrorProtect(AltIn!X,InputTextBuffer,V1,Radix) do
		ErrorAbort()
	]
	resultis VUsc(lv MPD>>MPD.Value,V1,(Width!X+15)/16)
]


//Invisible command (command files only)--skip if value in selected
//menu is equal, <, or > to InputTextBuffer
and SkipVEql(nil,nil,MPD) be if GetVal(MPD) eq 0 then SkipCommandCount = 1
and SkipVGr(nil,nil,MPD) be if GetVal(MPD) > 0 then SkipCommandCount = 1
and SkipVLs(nil,nil,MPD) be if GetVal(MPD) < 0 then SkipCommandCount = 1
and SkipVGrE(nil,nil,MPD) be if GetVal(MPD) ge 0 then SkipCommandCount = 1
and SkipVLsE(nil,nil,MPD) be if GetVal(MPD) le 0 then SkipCommandCount = 1
and SkipVNEql(nil,nil,MPD) be if GetVal(MPD) ne 0 then SkipCommandCount = 1

//Table!1 eq 0 is numeric, 1 search blocks, 2 symbolic
//Form!-1 is MemX for SearchBlocks, Form!-2 is procedure for symbolic
and ShowMode(lvTable,MBUnion,MPD) be
[	if MPD>>MPD.MDFS.MenuMode ne 0 do	//Non-idle
	[ let Form = FixForm((MPD>>MPD.AVal.TypeStorage eq MemTypeStorage ?
		MEMFORMS,REGFORMS)!(MPD>>MPD.AVal.X))
	  if Form eq 0 then ErrorAbort()
	  let NewMode = (rv lvTable)!1
	  switchon NewMode into
	  [ case 1: if Form!-1 < 0 then ErrorAbort(); endcase	//Search
	    case 2: if Form!-2 eq 0 then ErrorAbort()		//Symbolic
	    case 0: endcase					//Numeric
	    default: MidasSwat(BadModeTable)
	  ]
	  MPD>>MPD.AVal.DisplayMode = NewMode
	  MPD>>MPD.RebuildText = 1
	]
]


//Table!1 is 0 (octal), 1 (decimal), or 2 (hexadecimal)
and ChangeRadix(lvTable,MBUnion,MPD) be
[	if MPD>>MPD.MDFS.MenuMode ne 0 do	//Non-idle
	[ MPD>>MPD.AVal.Radix = (rv lvTable)!1
	  MPD>>MPD.RebuildText = 1
	]
]



and FillColumn(nil,MBunion,MPD) be
[	//Checks needed in command files
	if MPD>>MPD.MDFS.MenuMode eq 0 then ErrorAbort()
	if MPD>>MPD.AVal.TypeStorage ne MemTypeStorage do ErrorAbort()
	let DVec = vec 1
//Common operator error is examining item and then failing to clear
//input text line before doing FillC, so clear input line if not number.
	test InputTextBuffer!0 eq 0
	ifso DVec!0 = 100	//Fill whole column
	ifnot
	[ let FirstC = InputTextBuffer!1
	  test (FirstC < $0) % (FirstC ge $F) %
		((FirstC > $9) & (DefRadix ne 16)) %
		((FirstC > $7) & (DefRadix eq 8))
	  ifso DVec!0 = 100
	  ifnot unless SimpleTexttoDVec(InputTextBuffer,16,DVec) do
		ErrorAbort("Bad fill count")
	]
	let Letter = MPD>>MPD.MDFS.Letter
	let MemX = MPD>>MPD.AVal.X
	let Form = MEMFORMS!MemX
	let SkipMenus = ((Form ne 0) & (Form!0 < 0)) ? -Form!0,1
	for I = 1 to DVec!0 do
	[ //Pass over the selected MPD and its extensions to get next MPD
	  let L = MPD>>MPD.MDFS.LineN
	  let NextMPD = LookUpMenu(Letter,L+SkipMenus)
	  if NextMPD eq 0 then return
	  //Show next address symbolically if possible
	  let AVec = vec 1
	  MBlock(AVec,lv MPD>>MPD.AVal.Addr,2)
	  DoubleAdd(AVec,LongOne)
	  if VUsc(AVec,MEMLEN+MemX+MemX,2) ge 0 then return
	  Resets(InputStream)
	  SearchBlocks(InputStream,MemX,AVec,-1,true,GetRadix(MPD))
	  //SetAddr will ErrorAbort if the address is illegal or if
	  //all extensions won't fit in the column
	  SetAddr(nil,TopButton,NextMPD)
	  //Propagate other changes from MPD to NextMPD for all extensions
	  for E = 1 to SkipMenus do
	  [ NextMPD>>MPD.AVal.DisplayMode = MPD>>MPD.AVal.DisplayMode
	    NextMPD>>MPD.AVal.Radix = MPD>>MPD.AVal.Radix
	    MPD = LookUpMenu(Letter,L+E)
	    NextMPD = LookUpMenu(Letter,L+SkipMenus+E)
	  ]
	]
]


and CmdAddrEq(nil,nil,nil) be
[	if InputTextBuffer!0 le 0 do
	[ WssCSS("?? "); return ]
	let AVal,X = vec size AVal/16,1
	test EvalAText(InputTextBuffer,lv X,AVal,false)
	ifso ShowAddr(AVal)
	ifnot ErrorAbort(BadAText)
]


//Prettyprint the item named on the input text line on the comment
//streams and then copy the comment streams onto the output file as
//
//ADDRESS
//comment line 1 (if non-blank)
//comment line 2 (if non-blank)
and CmdPrettyPrint(nil,nil,nil) be
[	let X,AVal = 1,vec size AVal/16
	if CFOutStream eq 0 then ErrorAbort("No output file")
	unless EvalAText(InputTextBuffer,lv X,AVal,0) do ErrorAbort(BadAText)
	Puts(CFOutStream,$*N)
	for I = 1 to InputTextBuffer!0 do Puts(CFOutStream,InputTextBuffer!I)
	Puts(CFOutStream,$*N)
	X = AVal>>AVal.X
	let VValue = vec ValSize
	let Form,Width,Con,AltOut,MGet = nil,nil,nil,nil,nil
	test AVal>>AVal.TypeStorage eq RegTypeStorage
	ifso
	[ Form,Width,Con,AltOut = REGFORMS!X,REGWID!X,REGCON!X,AltRForms!X
	  MGet = MGetRegData
	]
	ifnot
	[ Form,Width,Con,AltOut = MEMFORMS!X,MEMWID!X,MEMCON!X,AltMForms!X
	  MGet = MGetMemData
	]
	let Radix = table [ 8; 10; 16; 8 ] ! (Con<<MRType.DefRadix)
	let LastExtension = (Form ne 0) & (Form!0 < 0) ? -1-Form!0,0
	for Extension = 0 to LastExtension do
	[ ResetsCSS(); ResetsCS1()
	  test MGet(X,VValue,lv AVal>>AVal.Addr,Extension)
	  ifso
	  [ DummyCall(AltOut,X,VValue,lv AVal>>AVal.Addr,
		Radix+(Extension lshift 8))
	    if CmdCS0Vec!0 ne 0 do	//CmdCommentStream
	    [ for I = 1 to CmdCS0Vec!0 do Puts(CFOutStream,CmdCS0Vec!I)
	      Puts(CFOutStream,$*N)
	    ]
	    if CmdCS1Vec!0 ne 0 do	//CmdCS1
	    [ for I = 1 to CmdCS1Vec!0 do Puts(CFOutStream,CmdCS1Vec!I)
	      Puts(CFOutStream,$*N)
	    ]
	  ]
	  ifnot Wss(CFOutStream,"Unreadable*N")
	]
]