//D0Prin1.bcpl	Procedures to prettyprint IM, IMX
//	Last edited: 20 October 1981

//The args to print routines are as follows:
//	X	MemX or RegX
//	DVec	The DataVec to be printed
//	AVec	An AddrVec which sometimes is relevant to what gets
//		printed (e.g., branch fields in IM printout show
//		".+1", ".+2", etc. relative to the AddrVec)
//	ExtRadix	Extension in l.h. (always 0 for D0) and radix
//		for printout in the r.h. (currently ignored since octal
//		is used everywhere)

get "d0.d" 
manifest [ get "d0regmem.d" ]

external
[
// MIDAS
	MidasSwat

// MASM
	GetField; PutsCSS; WssCS1; @WssCSS; @OddParity

// MSYM
	SearchBlocks

// MCMD
	CmdCommentStream; CmdCS1; WnsCSS; WnsCS1

// D0I0
	DVx

// D0I1
	BootTable; NBootInst; MIMtab

// D0ASM
	stNotInVM

// D0VM
	LookUpAA; LookUpVA; @VirtualP

// D0PRIN1ASM
	F1tab; F17F2tab; ALUbettab; ALUposttab0; BCtab; MEMtypetab

// D0PRIN1A
	CPrint; PrinC; PrinR; PrinVA

// Defined here
	PrinIM
]



let C1Wss(Str,Val) be
[	WssCS1(Str); WnsCS1(Val)
]


and SelfRel(X) = X!0 eq 0 ? 0,X+X!0

//Print out microinstruction--ambiguous printout for BLOCK and RSTK
//based upon emulator/non-emulator.  AddrVec is the address of the
//microinstruction, virtual or absolute for IM and IMX.
and PrinIM(X,DVec,AddrVec,ExtRadix) be
[	let CTASK = DVx>>srbus.ctask	//Frequently correct
//PrintTag winds up true to print the location before the contents of
//the instruction, false if not printing it.  Point is the location
//(virtual if VirtualP else absolute).  BA is the absolute location.
	let PrintTag,BA,Point = true,nil,AddrVec!1
	switchon X into
	[
case MIMx:	if MIMtab+(3*AddrVec!1) ge BootTable+(NBootInst*3) then
		[ WssCSS("never loaded"); return
		]
		X,Point,CTASK = IMXx,DVec!2 & #7777,#17
		BA = Point; endcase
case MDATAx:	Point = #170000	//Prevent .+n, .-n printout
		PrintTag = false
case IMXx:	BA = Point; endcase
case IMx:	if (DVec+3)>>IMV.Undef ne 0 then
		[ WssCSS(stNotInVM); return
		]
		BA = (DVec+3)>>IMV.Addr
		endcase
default:	MidasSwat(BadPrintIMMemX)
	]

//Print the m-i symbolically on the first comment line;
//print the individual m-i fields on the second comment line.

//M-i in IM, IMX, MIM, and MDATA are printed the same except that the
//tag is not printed for MDATA and the tag and branch targets are
//printed symbolically for IM.
//Form of virtual printout is:
//	TAG+3: GOTO[FOO+1,FOO+2,ALU=0], ...;
//Form of absolute printout is:
//	351: GOTO[64,ALU=0], ...;

	let PrinRoutine = VirtualP ? PrinVA,WnsCSS
	if PrintTag do
	[ test VirtualP
	  ifso 
	  [ test X eq IMXx
	    ifso PrinVA(BA,#100000)
	    ifnot SearchBlocks(CmdCommentStream,IMx,AddrVec)
	  ]
	  ifnot WnsCSS(BA)
	  WssCSS(": ")
	]

//These fields common to both types of m-i
	let MEMINST = GetField(0,1,DVec)
	let RSEL = #60 xor (GetField(2,4,DVec) lshift 2)+GetField(32,2,DVec)
	let F2 = GetField(18,4,DVec)
	let JC = GetField(22,3,DVec)
	let JA = (GetField(34,2,DVec) lshift 6) + GetField(25,6,DVec)
	let CSPar = OddParity(DVec!0 xor DVec!1,DVec!2 & #170000)
//Regular m-i only
	let RMOD = GetField(1,1,DVec)
	let ALUF = GetField(6,4,DVec)
	let BSEL = GetField(10,2,DVec)
	let F1 = GetField(12,4,DVec)
	let LR = GetField(16,1,DVec)
	let LT = GetField(17,1,DVec)
//Memory m-i only
	let DF2,TYPE = RMOD,ALUF
	let SRCDEST = GetField(10,8,DVec)

	let Rshift,StackShift,BranchShift,LoadPage=false,false,false,false
//Destinations for ALUA and H2
	let ADest1,ADest2,BDest1,BDest2 = 0,0,0,0
	let F1clause,F2clause = 0,0
	let NextInst,NextData = false,false
	let rwcs = false
//R Source stuff
	let RPred, Rsrc = 0,0
//ALUA correct unless RMOD is 1
	let ALUA =
	    (((RSEL rshift 4) eq 0 ? CTASK,CTASK & #14) lshift 4) % RSEL
	let ALUAvec = vec 1; ALUAvec!0 = 0

//**Is the (F1 rshift 2) ne 1 correct?  Know that F1 eq 5 is LoadPage[F2]
//**and F1 eq 7 is Group B, so F2 not ok, but F1 eq 4 and F1 eq 6 are
//**noops--do these disable F2?
	let f2ok = MEMINST ne 0 ? DF2 eq 0,
	  (BSEL eq 2) & ((F1 rshift 2) ne 1)
	if f2ok then switchon F2 into
	[
case 0:		Rshift = true; endcase
case 1:		ADest2 = "StkP_"; endcase
case 2:		F2clause = "FreezeResult"; endcase
case 3:		test CTASK eq 0
		ifso StackShift = true
		ifnot F2clause = "IOStrobe"
		endcase
case 4:		ADest2 = "CycleControl_"; endcase
case 5:		ADest2 = "DB_"; endcase
case 6:		ADest2 = "SB_"; endcase
case 7:		F2clause = "SpareF2"
		endcase
case 8:		BranchShift = true; endcase
case 9:		BDest2 = "SALUF_"; endcase
case 10:	endcase
case 11:	ADest2 = "MNBR_"; endcase
case 12:	ADest2 = "PCF_"; endcase
case 13:	F2clause = "ResetMemErrs"; endcase
case 14:	F2clause = "UseCoutAsCin"; endcase
case 15:	ADest2 = "Printer_"; endcase
	]

//Separate handling of m-i according to MEMINST
	C1Wss("MI=",MEMINST)
	test MEMINST eq 0
	ifso
	[ let rx = RSEL & 3
	  let f1ok = BSEL eq 2
	  if f1ok do
	  [ F1clause = SelfRel(F1tab+F1)
	    switchon F1 into
	    [
case 1:		BDest1 = "RS232_"; endcase
case 2:		ADest1 = "Timer_"; endcase
case 3:		ADest1 = "AddToTimer_"
case 5:		LoadPage = true; endcase
case 14:	NextInst = true; endcase
case 15:	NextData = true; endcase
case 7:		F1clause = SelfRel(F17F2tab+F2)
		switchon F2 into
		[
	case 8:		ADest1 = "APCTask&APC_"; endcase
	case 12 to 15:	rwcs = true
	default:	endcase
		]
//**case 0 BBFA requires Rshift true, but not checked
deafult:	endcase
	    ]
	  ]

	  if RMOD ne 0 do
	  [ test rx eq 3
	    ifso Rsrc = selecton RSEL rshift 2 into
		[
		 case 0: "SStkP&NStkP"
		 case 1: "ALUResult&NSALUF"
		 case 2: "MemSyndrome"
		 case 3 to 4: "UndefF2"
		 case 5:  Rshift ? "Printer","Cycle&PCXF"
		 case 6:  Rshift ? "DB&SB","Timer"
		 case 7:  Rshift ? "MNBR","RS232"
		 case 8: "APCTask&APC"
		 case 9: "CTask&NCIA"
		 case 10: "CSData"
		 case 11: "Page&Par&Boot"
		 case 12: StackShift ? "Stack&+2","Stack"
		 case 13: StackShift ? "Stack&+3","Stack&+1"
		 case 14: StackShift ? "Stack","Stack&-1"
		 case 15: StackShift ? "Stack&-3","Stack&-2"
		]
	    ifnot
	    [ RPred = selecton rx into
		[ case 0: "PCF["
		  case 1: "SB["
		  case 2: "DB["
		]
//The contents of PCF, SB, or DB replace RSEL[4:5]
	      ALUA = ALUA & #374
	      if rx eq 0 do
	      [	test NextInst
		ifso [ RPred = "NextInst["; F1clause = 0 ]
		ifnot if NextData do
		[ RPred = "NextData["; F1clause = 0 ]
	      ]
	    ]
	  ]

//Stuff for BSEL source and destination
//BSEL and F Constants provide at most one source and destination, but
//sometimes F's or LR  provide a second (or even 3rd) destination
	  let Bsrc = BSEL < 2 ? "C","T"
	  let FC = (F1 lshift 4)+F2
	  let fconst = BSEL < 2
	  let SFtype,POSmask,SIZEcount = 0,nil,nil
	  switchon BSEL into
	  [
case 1:		FC = FC lshift 8
case 0:
case 2:		endcase
case 3:		//Short-field stuff
		test FC < #207
		ifso		//LDF
		[ SFtype = 1	//SIZEcount,POSmask = nbits,leftbit
		  test FC < #20
		  ifso [ SIZEcount,POSmask = 1,FC ]
		  ifnot test FC < #37
		  ifso [ SIZEcount,POSmask = 2,FC-#20 ]
		  ifnot test FC < #55
		  ifso [ SIZEcount,POSmask = 3,FC-#37 ]
		  ifnot test FC < #72
		  ifso [ SIZEcount,POSmask = 4,FC-#55 ]
		  ifnot test FC < #106
		  ifso [ SIZEcount,POSmask = 5,FC-#72 ]
		  ifnot test FC < #121
		  ifso [ SIZEcount,POSmask = 6,FC-#106 ]
		  ifnot test FC < #133
		  ifso [ SIZEcount,POSmask = 7,FC-#121 ]
		  ifnot test FC < #144
		  ifso [ SIZEcount,POSmask = 8,FC-#133 ]
		  ifnot test FC < #154
		  ifso [ SIZEcount,POSmask = 9,FC-#144 ]
		  ifnot test FC < #163
		  ifso [ SIZEcount,POSmask = 10,FC-#154 ]
		  ifnot test FC < #171
		  ifso [ SIZEcount,POSmask = 11,FC-#163 ]
		  ifnot test FC < #176
		  ifso [ SIZEcount,POSmask = 12,FC-#171 ]
		  ifnot test FC < #202
		  ifso [ SIZEcount,POSmask = 13,FC-#176 ]
		  ifnot test FC < #205
		  ifso [ SIZEcount,POSmask = 14,FC-#202 ]
		  ifnot [ SIZEcount,POSmask = 15,FC-#205 ]
		  test POSmask eq 0
		  ifso		//Convert to RSH form
		  [ SFtype,SIZEcount = 2,16-SIZEcount
		  ]
		  ifnot if (SIZEcount+POSmask eq 16) &
			(SIZEcount eq 8) do	//RHMask
		  [ SFtype = 11
		  ]
		]
		ifnot test FC < #301
		ifso		//DISPATCH
		[ SFtype = 3
		  test FC < #227
		  ifso [ SIZEcount,POSmask = 1,FC-#207 ]
		  ifnot test FC < #246
		  ifso [ SIZEcount,POSmask = 2,FC-#227 ]
		  ifnot test FC < #264
		  ifso [ SIZEcount,POSmask = 3,FC-#246 ]
		  ifnot [ SIZEcount,POSmask = 4,FC-#264 ]
		]
		ifnot test FC < #320
		ifso		//LSH
		[ SFtype,SIZEcount = 4,FC-#300
		]
		ifnot test FC < #337
		ifso		//LCY
		[ SFtype,SIZEcount = 5,FC-#317
		]
		ifnot test FC < #341
		ifso test FC eq #337
		  ifso		//LHMASK
		  [ SFtype = 10
		  ]
		  ifnot		//ZERO
		  [ SFtype = 7
		  ]
		ifnot test FC eq #341
		ifso		//FixVA
		[ SFtype = 8
		]
		ifnot test FC < #347
		ifso
		[ SFtype = 12
		  POSmask = table [ #2; #4; #5; #6; #10 ] ! (FC-#342)
		]
		ifnot test FC < #356
		ifso		//RBsource & mask
		[ SFtype = 6
		  POSmask = table [ #2; #3; #4; #5; #6; #7; #10 ] !(FC-#347)
		]
		ifnot test FC eq #356
		ifso		//Nib0Rsh8
		[ SFtype = 9
		]
		ifnot		//Noops
		[
		]
		endcase
	  ]

	  if ADest2 eq 0 do
	  [ ADest2 = ADest1; ADest1 = 0
	  ]
	  if BDest2 eq 0 do
	  [ BDest2 = BDest1; BDest1 = 0
	  ]
	  let RPrinted = false

//ALU clause printed first
//Destinations first:
	  ALUAvec!1 = ALUA
	  if LR eq 1 then 
	  [ PrinR(RPred,Rsrc,ALUAvec); PutsCSS($_); RPrinted = true
	  ]
	  test LT eq 1
	  ifso WssCSS("T_")
	  ifnot if LR eq 0 then WssCSS("LU_")

//Stuff for ALU printout:
//ALUtype:  0=no args, 1=A only, 2=B only, 3 = both
	  let ALUtype = table [
		2; 1; 3; 3; 3; 3; 3; 3;
		1; 3; 3; 1; 3; 3; 0; 3 ] !ALUF
//First char of ALU expression is "(" unless the ALU function is purely
//ALUA or purely H2.
	  if ALUF ge 2 then PutsCSS($()
	  if (ALUtype & 1) ne 0 do	//Involves ALUA
	  [ CPrint(ADest2,ADest1)
	    PrinR(RPred,Rsrc,ALUAvec,SFtype,SIZEcount,POSmask)
	  ]
	  if ALUtype > 1 do		//Involves H2
	  [ CPrint(SelfRel(ALUbettab+ALUF))
	    CPrint(BDest2,BDest1)
	    if fconst then WnsCSS(FC)
	    WssCSS(Bsrc)
	  ]
	  CPrint(SelfRel(ALUposttab0+ALUF))

//If the ALU clause does not involve ALUA, print the ALUA clause now; print
//nothing if there is no ALUA destination, and the RM source was already
//printed as the ALU destination or is not one of the R-bus sources and is
//not involved in an RM branch condition or shifter-masker expression.
	  if (ALUtype & 1) eq 0 do
	  [ PrinC(ADest2,ADest1)
	    unless ((ADest2 eq 0) & (SFtype eq 0) &
		(RPrinted % ((Rsrc eq 0) & ((JC ne 2) % BranchShift))) &
		((Rsrc eq 0) % ((rx eq 3) & ((RSEL rshift 2) ge 12)))) do
	    [ if ADest2 eq 0 then WssCSS(", A_")
	      PrinR(RPred,Rsrc,ALUAvec,SFtype,SIZEcount,POSmask)
	    ]
	  ]

//If the ALU clause does not involve H2, print H2 clause now unless
//there is no destination for H2 and the source is T.
	  if ALUtype le 1 do
	  [ PrinC(BDest2,BDest1)
	    unless (BDest2 eq 0) & (fconst eq 0) do
	    [ if BDest2 eq 0 then WssCSS(", H2_")
	      if fconst then WnsCSS(FC)
	      WssCSS(Bsrc)
	    ]
	  ]

//Print any standalone F1 clause
	  PrinC(F1clause)
	  if f1ok & (F1 eq 5) then [ WnsCSS(F2); PutsCSS($]) ]

	  C1Wss(",RMOD=",RMOD)
	  C1Wss(",RSEL=",RSEL)
	  C1Wss(",ALUF=",ALUF)
	  C1Wss(",BSEL=",BSEL)
	  C1Wss(",F1=",F1)
	  C1Wss(",LR=",LR)
	  C1Wss(",LT=",LT)
	]

	ifnot		//MEMINST eq 1
	[ let SDvec = vec 1; SDvec!0 = 0
	  SDvec!1 = SRCDEST eq 0 ? 0, SRCDEST % (CTASK lshift 4)
	  ALUAvec!1 = ALUA
	  test (TYPE ne #2) & (TYPE ne #7) & (TYPE ne #13)
	  ifso
	  [ if (ALUA & 1) ne 0 then WssCSS("Odd")
	    WssCSS(SelfRel(MEMtypetab+TYPE))
	    SearchBlocks(CmdCommentStream,RMx,ALUAvec)	//Base reg.
	  ]
//Input, Output, & ReadPipe print the base register last iff non-zero
	  ifnot WssCSS(SelfRel(MEMtypetab+TYPE))
	  switchon TYPE into
	  [
case 4 to 6:
case 8 to 10:
case 14:	PutsCSS($,)
case 2:
case 11:
case 7:	//Types that have R source or destination
		test SDvec!1 eq 0
		ifso WssCSS("Stack")
		ifnot SearchBlocks(CmdCommentStream,RMx,SDvec)
		if DF2 eq 1 then
		[ PutsCSS($,); WnsCSS(F2)
		]
	//Input, Output, & ReadPipe print base reg arg third iff non-zero.
		if ((TYPE eq #2) % (TYPE eq #7) % (TYPE eq #13)) &
			((ALUA & #17) ne 0) do
		[ if DF2 eq 0 then PutsCSS($,)
		  PutsCSS($,); SearchBlocks(CmdCommentStream,RMx,ALUAvec)
		]
case 0:		//Undef
case 3:		//Refresh
		endcase
case 1:
case 12 to 13:
case 15:	//Types that have device source or destination
		if DF2 eq 1 do
		[ PutsCSS($,); WnsCSS(F2)
		]
		endcase
	  ]
	  PutsCSS($])

	  C1Wss(",DF2=",DF2)
	  C1Wss(",RSEL=",RSEL)
	  C1Wss(",TYPE=",TYPE)
	  C1Wss(",SRCDEST=",SRCDEST)
	]
	C1Wss(",F2=",F2)
	C1Wss(",JC=",JC)
	C1Wss(",JA=",JA)
	WssCS1(CSPar ? ",Par ok",",Par bad")

//Standalone F2 clause
	PrinC(F2clause)

//Control clause
	let NxtA = (BA & #7400) + JA
	switchon JC into
	[
case 0 to 3:	NxtA = NxtA % 1
		PrinC("DblGoTo["); endcase
case 6:		unless rwcs do
		[ PrinC(((JA & 1) ne 0 ? "NIRet","Return")); endcase
		]
case 4:		PrinC("GoTo["); endcase
case 5:		PrinC("Call["); endcase
case 7:		PrinC("Disp["); endcase
	]
	if (JC ne 6) % rwcs do
	[ PrinRoutine(NxtA,Point)
	  if JC < 4 do
	  [ PutsCSS($,); PrinRoutine(NxtA & #177776,Point); PutsCSS($,)
	    WssCSS(SelfRel(BCtab+((BranchShift & #10)+
			(JC lshift 1)+(JA & 1))))
	  ]
	  PutsCSS($])
	]

	test (BA & #6003) eq #2001
	ifso
	[ PrinC("Opcode["); WnsCSS((BA rshift 2) & #377); PutsCSS($])
	]
	ifnot if VirtualP do
	  [ PrinC("At["); WnsCSS(BA); PutsCSS($])
	  ]
]