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