//D1Prin1.bcpl Procedures to prettyprint IM, IMX, LDR, MIR, and IMBD
// Last edited: 21 July 1980
get "d1.d" //For MidasSwat arg defs
manifest [ get "d1regmem.d" ]
manifest [ get "d1dmux.d" ]
external [
// MIDAS
MidasSwat
// MASM
Wss; PutsCSS; @WssCSS; WssCS1; SelfRel; GetField; VUsc
// MIOC
Wns
// MRGN
CharInputRoutine
// MTXTBUF
ClearInText
// MSYM
SearchBlocks
// MCMD
CmdCommentStream; CmdCS1; WnsCSS; WnsCS1
// D1I0
BreakMIR; DMuxSelect; DWrong; DChecked
// D1ASM
stNotInVM
// D1MEM
MGetMemData; @SaveTask
// D1VM
LookUpAA; LookUpVA; @VirtualP
// D1CONFIG
IMXmask
// D1PRIN1A
PrinBMux; PrinAMux; CPrint; PrinC; PrinVA; PrinBC; PrinCRAddr
// D1PRINASM
FFtab; BCtab; ShiftTab; ALUStab; RMtab; IMWriteT; IMReadT
MemRT; SMemRT
// Defined here
PrintIM; ClausePrinted
]
static [ ClausePrinted ]
let C1Wss(Str,Val) be
[ WssCS1(Str); WnsCS1(Val)
]
//Print out microinstruction in MIR, IMOUT, IM, IMX, IMBD, or LDR.
//AVec is the instruction address, virtual for IM, absolute for IMX
//or IMBD, and irrelevant for MIR, IMOUT, and LDR.
and PrintIM(X,DVec,AVec,Radix) be
[ let DV2,DV3,AVec1 = DVec!2,DVec!3,vec 1
AVec1!0 = 0
let RSTK = GetField(0,4,DVec)
let ALUF = GetField(4,4,DVec)
let BSEL = GetField(10B,3,DVec)
let LC = GetField(13B,3,DVec)
let ASEL = GetField(16B,3,DVec)
let BLOCK = GetField(21B,1,DVec)
let FF = GetField(22B,10B,DVec)
let JCN = GetField(32B,10B,DVec)
C1Wss("RSTK=",RSTK)
C1Wss(", ALUF=",ALUF)
C1Wss(", BSEL=",BSEL)
C1Wss(", LC=",LC)
C1Wss(", ASEL=",ASEL)
C1Wss(", BLOCK=",BLOCK)
C1Wss(", FF=",FF)
C1Wss(", JCN=",JCN)
//Assume emulator task unless a better guess is possible; printout varies
//for tasks 0, 17B, and other.
let Task = 0
//BA is originally the AA of the instruction if relevant; it is transformed
//into the branch target address later. Point winds up with the VA if
//VirtualP is true and the location is in the VM, else with the AA.
let BA,Point = nil,nil
//PrintTag is true if the location of the instruction is ascertained,
//else false (only false for LDR and for MIR in some cases).
//CallOK is true for absolute printout; for virtual printout it is
//true iff .+1 in the virtual space is .+1 in the absolute space;
//CallOK controls printout of return or branch to a call location as
//CoReturn/Call or as Return/Branch.
let PrintTag,CallOK = true,true
//Transform the environment for MIR or IMOUT printout into the
//appropriate IM or IMX environment when this seems appropriate.
//Print IMBD as IM/IMX according to VirtualP. Compute the task
//when possible.
switchon X into
[
case IMXx:
case IMBDx: BA = AVec!1; endcase
case MIRx: Task = SaveTask
if VUsc(DMuxSelect+dSaveMIR,BreakMIR,4) eq 0 do
[ BA = DMuxSelect!dCIA; endcase
]
//Kludge for pretty-print of MDATA items when testing MIR, IMBD, or IMX
case MDATAx:
case LDRx: PrintTag,BA = false,0; endcase
case IMOUTx: BA = (DMuxSelect!dCJNK1 & 40000B) eq 0 ?
DMuxSelect!dBNPC,DMuxSelect!dTNIA
Task = DMuxSelect!dNEXT; endcase
//**Interim DVec!3 arrangement until MicroD output revised
case IMx: if (DV3 & 20000B) ne 0 then
[ WssCSS(stNotInVM); return
]
BA = DV3 & 7777B
if (DV3 & 10000B) eq 0 then Task = 1
endcase
default: MidasSwat(UnexpectedIMMemX)
]
if (X eq MIRx) % (X eq IMOUTx) do
[ test (DMuxSelect eq DWrong)
ifso
[ WssCSS("Errors:"); return
]
ifnot if (DMuxSelect eq DChecked) do
[ WssCSS("Checked:"); return
]
]
BA = BA & IMXmask
if PrintTag do
[ DV3 = VirtualP ? LookUpVA(BA),-1
test DV3 ge 0
ifso
[ X,Point = IMx,DV3
CallOK = (Point ne IMXmask) &
(((BA & 177700B)+((BA+1) & 77B)) eq LookUpAA(Point+1))
]
ifnot
[ X,Point = IMXx,BA
]
]
AVec1!1 = Point
let OtherClause1,BDest2 = 0,0
//FFok is false if BSEL selects constant or long goto/call
let FFok = BSEL < 4
let Page,Quadrant = BA & 177700B,BA & 170000B
let BRtype,BC1,BC2 = nil,-1,-1
//Stuff for control clause
test JCN ge 200B
ifso test JCN ge 300B
ifso //Global call
[ BA = ((JCN & 77B) lshift 6)+Quadrant; BRtype = 2
]
ifnot //Local goto/call
[ BA = Page+(JCN & 77B)
BRtype = 0
]
ifnot test JCN < 20B
ifso //Long goto/call
[ BA = (FF lshift 4)+JCN+Quadrant
BRtype = 1; FFok = false
]
ifnot test (JCN & 7B) ne 7B
ifso //Conditional branch
[ BA = Page+((JCN rshift 1) & 60B)+((JCN rshift 2) & 6B)
BRtype = 3; BC1 = JCN & 7B
]
ifnot test JCN ge 100B
ifso //Return function
[ BA = Page+((BA+1) & 77B)
switchon (JCN rshift 3) & 7B into
[
case 0:
case 1:
case 2:
case 3: BRtype = 4; endcase //Normal return
case 4: BDest2 = "RdTPC"; BRtype = 5; endcase
case 5: BDest2 = "LdTPC"; BRtype = 5; endcase //.+1 goto
case 7: BDest2 = SelfRel(IMWriteT+(RSTK & 7))
BRtype = 5; endcase //.+1 goto
case 6: OtherClause1 = SelfRel(IMReadT+(RSTK & 3))
BRtype = 5; endcase //.+1 goto
]
]
ifnot //IFUjump
[ BRtype = 6; BA = (JCN rshift 3) & 3B
]
//Stuff for AMux source and destination
//ASrc0 is reserved for the "X" part of shift ops,
//ASrc1 for the shift string or ASEL string, and
//ASrc2 for the FF AMux source; ADest is 0, the memory request destination,
//or "A←" for shifts in conjunction with FF-encoded AMux sources
let ADest,ASrc0,ASrc1,ASrc2,MemBDest = "A",0,0,0,0
let ShiftFn,AShs1,AShs2,AShsLast = nil,0,0,0
let AShccnt,AShsize,AShpos = -1,-1,-1
let FFfunc,FFlow4 = FF,FF & 17B
let FAmem = FFok ? FF rshift 6,3
test ASEL < 4
ifso
[ FFfunc = FFfunc & 77B
ADest = SelfRel(MemRT+(ASEL lshift 2)+FAmem)
//Note: ASrc1 is 0 when the source is RM/STK
test ASEL < 2
ifso
[ if FAmem eq 1 then
test (Task eq 0) % (Task eq 17B)
ifso if ASEL eq 0 then MemBDest = "MapBuf"
ifnot ADest = (ASEL eq 0 ? "IOFetch","IOStore")
]
ifnot ASrc1 = SelfRel(SMemRT+FAmem)
if ((FAmem eq 3) & (ASEL eq 0)) % (ASEL eq 2) then
MemBDest = "DBuf"
]
ifnot switchon ASEL into
[
case 5: ASrc1 = "Id"
case 4: endcase
case 6: ASrc1 = "T"; endcase
case 7: if (ALUF & 1) ne 0 then ASrc0 = "X"
ShiftFn = ALUF rshift 1
ALUF = ALUF % 16B
test BSEL < 4
ifso ASrc1 = SelfRel(ShiftTab+ShiftFn)
ifnot
[ if (ShiftFn & 4) ne 0 then AShsLast = "Md"
//AShs1 and AShs2 will be set to RM/STK source later, if appropriate
AShs1 = "T"
AShs2 = AShs1
switchon ShiftFn & 3 into
[
case 0: ASrc1 = "LCY["; AShccnt = FFlow4; endcase
case 1: ASrc1 = "LDF["; AShsize = FF rshift 4
AShpos = 17B & (-FF); endcase
case 2: ASrc1 = "LSH["; AShccnt = FFlow4; endcase
case 3: ASrc1 = "DPF["; AShpos = FFlow4
AShsize = 20B-AShpos-(FF rshift 4)
if AShsize < 0 then AShsize = 0; endcase
]
]
endcase
]
//RDestKnown will be false barring the change-RBase-for-write function;
//might sometime modify D1lang/MicroD to pass the assumed value of RBase
//through to Midas as auxiliary information. RDest will for now hold
//a value (0-#17, #400-#417, or #420-#437)+1 according to whether the RM
//source is RM, STK, or STK with ModStkPAfterW function. RPrinted will
//wind up true if the RM source is printed as the Pd or Md destination or
//as a source for A or B. RSrc and RNoSrcDest will contain the RM address+1
//or a string pointer to the stack operation string.
let RDestKnown,RSrc,RPrinted = false,RSTK+1,false
let RNoSrcDest,RDest = RSrc,RSrc
if (Task eq 0) & (BLOCK ne 0) do
[ RSrc,BLOCK = SelfRel(RMtab+RSTK),0
RNoSrcDest = SelfRel(RMtab+RSTK+#40)
RDest = RDest+#400
]
//Stuff for ALU printout:
//ALUtype: 0=no args, 1=A only, 2=B only, 3 = both
//APred, BPred, BPost are strings before A, before B, and after B
//ALUPred precedes and ALUPost follows the entire ALU expression
let ALUtype,ALUPred,APred,BPred,BPost,ALUPost = 0,0,0,0,0,0
//First part of LC decode (1 if T←Md, 2 if T←Pd, 4 if R←Md, 10B if R←Pd)
let H3Dest2 = table [ 0; 2; 11B; 1; 4; 6; 10B; 12B ] !LC
//Stuff for functions exclusive of branch conditions
let AFMflag,AFMRWflag = false,false
let BSrc,BDest1 = 0,0
let H3Src = 0
let FFtype,FFstring = 0,0
if FFok do
[ FFstring = SelfRel(FFtab+FFfunc)
switchon FFfunc rshift 3 into
[
case 0B to 1B: //AMux destinations
ASrc2 = FFstring; endcase
case 4B to 5B: //Change RAddr[4:7] for write
RDest = FFlow4+1; endcase
case 6B: //Branch conditions
BC2 = FFfunc & 7B; endcase
case 16B to 17B: //External BMux sources
if BSEL eq 3 then BDest1 = "Q"
BSrc = FFstring; endcase
case 34B to 35B: //Cnt←20S, 1S, ..., 17S
if FFlow4 eq 0 then FFlow4 = #20
case 20B to 21B: //RBase←0S to 17S
FFtype = 5; endcase
case 22B to 23B: //Change RBase for write
RDest = (FFlow4 lshift 4)+RSTK+1
RDestKnown = true; endcase
case 24B: //TIOA[0] to TIOA[7]
FFtype = 2; endcase
case 25B: //MemBaseX← and MemBX← 0 to 3 (use BRX symbol)
FFlow4 = FFlow4 & #3; FFtype = 6; endcase
case 30B to 33B: //MemBase←0 to 37 (use BR symbol)
FFtype = 3; endcase
case 36B to 37B: //Wakeup[task]
FFtype = 4
default: endcase
]
switchon FFfunc into
[
case 20B: ASrc2,RPrinted = RSrc,true; endcase
case 21B to 23B:
ASrc2 = FFstring; endcase
//ALUFMEMRW is both a BMux destination and H3 source
case 262B: AFMRWflag,AFMflag = true,true
case 36B: case 70B to 71B: case 73B: case 100B to 101B:
case 105B to 107B: case 127B to 131B:
case 134B to 135B: case 137B:
case 141B: case 144B: case 146B to 147B:
case 152B: case 154B: case 157B:
BDest1 = FFstring; endcase //BMux destinations
case 120B to 124B: case 126B: case 155B to 156B:
ADest = FFstring; endcase //AMux destinations
case 24B to 26B: case 31B:
case 34B to 35B: case 37B: case 72B: case 76B:
case 102B to 103B:
case 125B: case 132B to 133B: case 136B:
case 140B: case 142B to 143B: case 145B:
case 150B to 151B:
case 276B to 277B: //Standalone functions
FFtype = 1
default: endcase //Already handled
case 75B: if (H3Dest2 & 2) ne 0 then H3Dest2 = H3Dest2 xor 3
endcase
//ModStkPAfterW
case 27B: if RDest ge #401 do
[ RSrc,RDest = SelfRel(RMtab+RSTK+#20),RDest+#20
]
case 260B to 261B: endcase //No ops
//ALUFMEM is an H3 source with special ALUF printout
case 263B: AFMflag = true
case 264B to 267B:
case 32B to 33B: //Pd sources
H3Src = FFstring; endcase
//ALU fn enclosures (shifts)
case 270B to 275B:
ALUPred = "("; ALUPost = FFstring; endcase
]
]
//Fix up RDest to point at a string for Stk ops, contain addr+1 for RM ops.
if RDest ge #401 then RDest = SelfRel(RMtab+RDest-#401)
//If there is no other B destination print "Md←" or "MapBuf←" as the
//destination on Store← or Map← references.
if BDest1 eq 0 then BDest1 = MemBDest
//Next decode LC field previously recoded in H3Dest2
let MdDest1 = (H3Dest2 & 4) ne 0 ? RDest,0
let MdDest2 = (H3Dest2 & 1) ne 0 ? "T",0
if MdDest1 eq 0 then
[ MdDest1,MdDest2 = MdDest2,0
]
let H3Dest1 = (H3Dest2 & #10) ne 0 ? RDest,0
H3Dest2 = (H3Dest2 & 2) ne 0 ? "T",0
if H3Dest1 eq 0 do
[ H3Dest1,H3Dest2 = H3Dest2,0
if (H3Dest1 eq 0) & not (AFMflag & not AFMRWflag) do H3Dest1 = "Pd"
]
//Stuff for ALUF
test AFMflag //Special ALUFMEM stuff?
ifso if AFMRWflag then
[ ALUtype,BPred,BPost = 2,"(",")"
]
ifnot
[ test X eq LDRx
ifso //Know LDR ALUFM is "NOT A" in 16, "B" in 0
//else force "Strange(...)"
[ ALUF = ALUF eq 16B ? 1,(ALUF eq 0 ? 25B,30B)
]
ifnot
[ let ALUFAVec = vec 1; ALUFAVec!0 = 0; ALUFAVec!1 = ALUF
MGetMemData(ALUFMx,lv ALUF,ALUFAVec)
ALUF = ALUF rshift 8
]
let ALUfnc = ALUF & 37B
ALUtype = table [ //0=no args, 1=AMux only, 2=BMux only, 3=other
1; 1; 3; 3; 3; 3; 1; 0;
3; 3; 3; 2; 3; 3; 3; 3;
3; 3; 3; 3; 3; 2; 3; 3;
3; 0; 3; 3; 3; 3; 1; 1 ] !ALUfnc
APred = SelfRel(ALUStab+selecton ALUfnc into
[
case 0B: (ADest ne 0) %((ALUF & 200B) ne 0) ? 4,0
case 37B: ADest ne 0 ? 4,0 //"A"--"(" if with dest else nothing
case 25B: (BDest1+BDest2) ne 0 ? 4,0 //"B"--"(" or nothing
case 7B: 2 //"A1"
case 31B: 1 //"A0"
case 1B: case 3B:
case 5B: case 11B:
case 13B: case 21B: 3 //"not ("
case 14B to 15B: case 17B:
case 22B to 23B: case 27B:
case 33B: case 35B to 36B: 4 //"("
case 6B: 16 //"2 ("
default: 17 //"Strange("
] )
//0 = AluOp(one arg) and AluOp(no args) have no between string
// 6 = ") and not ("
// 7 = ") xor ("
// 8 = ") xnor ("
// 9 = ") or ("
//10 = ") or not ("
//11 = ") and ("
//12 = ") - ("
//13 = ") + ("
//18 = ","
BPred = SelfRel(ALUStab+(table [
0; 0; 18; 10; 18; 9; 0; 0;
18; 6; 18; 0; 13; 8; 18; 10;
18; 11; 12; 7; 18; 0; 18; 9;
18; 0; 18; 6; 18; 11; 0; 0 ] ! ALUfnc))
BPost = SelfRel(ALUStab+
selecton ALUF & ((ALUF & 1) ne 0 ? 37B,237B) into
[
case 0B: case 37B: ADest ne 0 ? 5,0 //Nothing or ")" for "A"
case 25B: (BDest1+BDest2) ne 0 ? 5,0 //Nothing or ")" for "B"
case 7B: case 31B: 0
case 200B: case 206B: case 214B: 15 //") + 1"
case 22B: case 36B: 14 //") - 1"
default: 5 //")"
] )
]
//Delete separate RSrc clause if used elsewhere, default AMux and
//BMux sources and destinations, if not given previously
if (ASrc1 eq 0) & (ASrc2 eq 0) do
[ ASrc1,RPrinted = RSrc,true
]
test BSEL < 4
ifso if BSEL eq 1 then RPrinted = true
ifnot
[ if ASEL eq 7 do
[ if BSEL < 6 do
[ AShs1,RPrinted = RSrc,true
]
if (BSEL & 1) eq 0 do
[ AShs2,RPrinted = RSrc,true
]
BSEL = 3
]
]
if (MdDest1 eq RSrc) % (H3Dest1 eq RSrc) then RPrinted = true
if (BDest1 eq 0) & (BDest2 eq 0) & (ALUtype le 1) then
BDest1 = "B"
//Stuff for BMux source and destination
//BSEL and FF provide at most one source and destination, but sometimes
//IM or TPC read/write provides a second destination
if BSrc eq 0 then BSrc = selecton BSEL into
[ case 0: "Md"
case 1: RSrc
case 2: "T"
case 3: "Q"
case 4: FF
case 5: FF+#177400
case 6: FF lshift 8
case 7: (FF lshift 8)+#377
]
//Now have the relevant information for the control clause in BRtype,
//BA, BC1, and BC2. Have BMux stuff in BDest1, BDest2, and BSrc.
//Have AMux stuff in ADest, ASrc1, and ASrc2. The string for FF is in
//FFstring and is relevant if FFtype ne 0. FFtype eq 1 is a standalone
//function, 2 TIOA[n], 3 MemBase←BRsym, 4 Wakeup[n], 5 RBase←nS Cnt←nS,
//and 6 MemBaseX←BRXsym or MemBX←BRXsym.
//H3Src is 0 if the ALU or ALU shift goes into Pd or a string pointer for
//any other Pd source replacing the ALU.
//H3Dest1 and H3Dest2 are the destinations for the H3 source.
//MdDest is the destination for Md. The kind of ALU clause is given in
//ALUtype (0=no args, 1=A only, 2=B only, 3=both A and B). The
//strings for the ALU op are given in ALUPred, APred, BPred, BPost, and
//ALUPost.
let LeftArrow = "←"
//Form of virtual printout is:
// TAG+3: LocGo[FOO+1,FOO+2,ALU=0], T←(Fetch←T)+(R0), MemBase←3S;
//Form of absolute printout is:
// 351: LocGo[64,ALU=0], T←(Fetch←T)+(R0), MemBase←3S;
//In other words, printout is the same except for tag and branch
//address.
let PrinRoutine = X eq IMx ? PrinVA,WnsCSS
if PrintTag do
[ test X eq IMx
ifso SearchBlocks(CmdCommentStream,IMx,AVec1)
ifnot WnsCSS(Point)
WssCSS(": ")
]
test BRtype < 4
ifso
[ WssCSS(selecton BRtype into
[ case 0: "Loc"
case 1: "Long"
case 2: "G"
case 3: "F"
] )
WssCSS((BA & 17B) ne 0 ? "Go[",(CallOK ? "Call[","Branch["))
test (BC1 ge 0) % (BC2 ge 0)
ifso
[ PrinRoutine(BA%1,Point); PutsCSS($,)
PrinRoutine(BA,Point); PrinBC(BC1); PrinBC(BC2)
]
ifnot PrinRoutine(BA,Point)
PutsCSS($])
]
ifnot test BRtype eq 6
ifso
[ WssCSS("IFUjump["); WnsCSS(BA); PutsCSS($])
]
ifnot if BRtype eq 4 then
WssCSS((CallOK & (X eq IMx) ? "CoReturn","Return"))
//We have a branch clause unless IM/TPC read-write occurring
ClausePrinted = BRtype ne 5
PrinC(OtherClause1)
//Print the RM/STK source as a separate clause, if not printed elsewhere
if not RPrinted do PrinCRAddr(RNoSrcDest,false,true)
//If two AMux clauses print one now
if (ASrc1 ne 0) & (ASrc2 ne 0) do
[ PrinC(ADest,LeftArrow)
PrinCRAddr(ASrc2,false,false)
ASrc2,ADest = 0,"A"
]
//If the ALU clause does not involve AMux, print the (remaining) AMux
//clause now
if (ALUtype eq 0) % (ALUtype eq 2) do
[ if ClausePrinted then WssCSS(", ")
PrinAMux(ADest,ASrc0,ASrc1,ASrc2,AShs1,AShs2,AShsLast,AShccnt,
AShsize,AShpos,false)
ClausePrinted = true
]
if AFMflag do
[ PrinC("Aluf["); WnsCSS(ALUF); PutsCSS($])
]
//Now print the Md clause
if MdDest1 ne 0 do
[ PrinCRAddr(MdDest1,RDestKnown,true); PutsCSS($←)
CPrint(MdDest2,LeftArrow)
WssCSS("Md")
]
//Now print the Pd clause (always have H3Dest1 ne 0)
PrinCRAddr(H3Dest1,RDestKnown,true); PutsCSS($←)
CPrint(H3Dest2,LeftArrow)
CPrint(H3Src,(AFMflag ? "",", Alu←"))
CPrint(ALUPred); CPrint(APred)
if (ALUtype & 1) ne 0 then
PrinAMux(ADest,ASrc0,ASrc1,ASrc2,AShs1,AShs2,AShsLast,
AShccnt,AShsize,AShpos,false)
CPrint(BPred)
if (ALUtype > 1) then PrinBMux(BDest1,BDest2,BSrc,BSEL,BC2,false)
CPrint(BPost); CPrint(ALUPost)
//If the ALU clause does not involve BMux, print BMux clause now
if (ALUtype le 1) do
[ WssCSS(", "); PrinBMux(BDest1,BDest2,BSrc,BSEL,BC2,false)
]
//Finally, the FF stuff if not handled yet
let AVX = vec 1; AVX!0 = 0
if FFtype ne 0 do
[ PrinC(FFstring)
switchon FFtype into
[
//TIOA[i]
case 2: WnsCSS(FF & #7); PutsCSS($])
case 1: endcase
case 3: AVX!1 = FF & 37B
unless SearchBlocks(CmdCommentStream,BRx,AVX,-1,false) do
PutsCSS($S)
endcase
//Wakeup[i]
case 4: AVX!1 = FFlow4
SearchBlocks(CmdCommentStream,TASKNx,AVX,-1,false)
PutsCSS($]); endcase
//RBase←nS, Cnt←nS
case 5: WnsCSS(FFlow4); PutsCSS($S); endcase
//MemBaseX←nS or MemBX←nS
case 6: AVX!1 = FFlow4
unless SearchBlocks(CmdCommentStream,BRXx,AVX,-1,false) do
PutsCSS($S)
endcase
default: MidasSwat(UnexpectedFFtype)
]
]
if BLOCK ne 0 then WssCSS(", Block")
PrinC(selecton (DV2 rshift 12) & #3 into
[ case 0: 0
case 1: "PE2141"
case 2: "PE020"
case 3: "Brkp"
] )
]