//d0mem.bcpl	hardware interface procedures for register read/write
//	Last edited: 20 August 1981

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

external [
// OS
	Zero

// MINIT0
	@MBlock

// MIDAS
	Initialized; MidasSwat

// MASM
	@OddParity

// MDATA
	MCTimeOut

// MMPRGN
	UpdateMPDValues

// MCMD
	ErrorAbort

// MLOAD
	DoingLoad

// D0I0
	DVx; BPTable; MIMtab; BootTable; NBootInst

// D0I1
	d0mem; d0rdt; d0rdtpc; d0wrtt; d0rdmi; d0wrttpc; d0wsr; d0rsr

// D0TABLES
	@MEMCON

// D0ASM
	sendbyte; sendword; recvbyte; recvword; ConvertAV
	@MADDRL; @MADDRH; stUndAdr

// D0REG
	MGetChecks; MPutChecks; MakeVA; MakeAA

// D0VM
	LookUpAA

// D0LOAD
	AddToVM

//Defined here for use by machine-independent code
	GetMemData; MGetMemData; PutMemData; MPutMemData; MDATAmemx

// Defined here for use by D0go.bcpl, D0asm.asm, etc.
	sovlcurr; sovlput; wrtrr; readrr; readtpc; GenCorrPar
	KIMloMax	//Upper bound on pg 0 Kernel instr.
	KIMhiMin	//Lower bound on pg 16-17 Kernel instr
]
static
[	MDATAmemx = MDATAx; sovlcurr = 0; //there is no overlay 0
	KIMloMax=0; KIMhiMin=#7777
]

//GetMemData, PutMemData, MGetMemData, and MPutMemData accept a memory 
//index MemX, a double-precision AddrVec, and a DataVec. The T and TPC 
//memories which are task-specific registers also accept an address of 20 
//interpreted as the current task (i.e., selected by CTASK).

//The general strategies followed by Midas in its attempts to show and
//preserve the machine state are as follows:
//Midas interfaces with a set of micro-code on the D0 which is called the 
//Kernel Micro-Code (KMC).  The KMC saves status whenever a halt condition 
//occurs.

//When the D0 encounters a BreakPoint micro-instruction, the KMC is 
//entered from the Fault Code.  The D0 will encounter BreakPoint 
//instructions following each Single-Step, in addition to programmer 
//inserted breakpoints.

//After execution of the BreakPoint micro-instruction, the Fault Micro-code 
//will be entered and when there are no faults, the KMC will start, and 
//save the hardware state in the register block and send a message to MIDAS 
//informing it that a BreakPoint micro-instruction was executed.

//GET[mem] commands from MIDAS will get the specified memory, and 
//GET[reg] of the saved hardware state will get the saved value rather than 
//the hardware value.  

//PUT[mem] commands from MIDAS will put to the specified memory, and 
//PUT[reg] to the saved hardware state will put to the saved value rather 
//than the hardware.

let GetMemData(MemX,DVec,AVec) = valof
[	let T = nil
	switchon ConvertAV(AVec,MemX) into
	[
case IMx:	MADDRL = LookUpAA(MADDRL,DVec)
		if MADDRL < 0 do	//Outside VM
		[ Zero(DVec,3); resultis false
		]
case IMXx:	readmi(MADDRL,DVec); endcase
case RMx:	readrr(MADDRL,DVec); endcase
case Tx:	readt(MADDRL,DVec); endcase
case TPCx:	readtpc(MADDRL,DVec);
		DVec!0 = MakeVA(DVec!0) lshift 4; endcase
case VMx:	MADDRL = setupmm(AVec,DVec)
		test MADDRL ge 0
		ifso readrr(MADDRL & #37777,DVec)
		ifnot DVec!0 = #52525
		endcase
case MAPx:	readmap(MADDRL,DVec); endcase
case BPx:	MBlock(DVec,BPTable+(MADDRL lshift 2),4); endcase
case MIMx:
case MDATAx:	MBlock(DVec,MADDRL,3); endcase
case MADDRx:	MBlock(DVec,MADDRL,2); endcase
//Legitimately get here only when ConvertAV fails; presently this can
//never happen because CertifyAV has blessed the addresses.
default:	resultis false
	]
	resultis true
]


and MGetMemData(MemX,DVec,AVec,lvExtension) =
	MGetChecks(MEMCON!MemX) ? GetMemData(MemX,DVec,AVec),false

and PutMemData(MemX,DVec,AVec) = valof
[	let DV1 = vec 1
	switchon ConvertAV(AVec,MemX) into
	[
case IMx:	unless Initialized do
//Must be loading KERNEL: copy microinstructions into BootTable after
//fixing parity.
		[ if (DVec!3 & #140000) ne 0 do
			MidasSwat(KernelBP)
		  if BootTable+(3*NBootInst) ge MIMtab+(3*MIMlen) do
			MidasSwat(KernelOvf)
		  let Targ = BootTable+(NBootInst*3)
		  NBootInst = NBootInst+1
		  let Addr = (DVec+3)>>IMV.Addr
		  Targ!0,Targ!1 = DVec!0,DVec!1
		  Targ!2 = (DVec!2 & #170000)+Addr
		  GenCorrPar(Targ)
//Note min and max addresses for "Test" action.
		  test Addr < #4000
		  ifso if Addr ge KIMloMax then KIMloMax = Addr
		  ifnot if Addr < KIMhiMin then KIMhiMin = Addr
		  endcase
		]
//Prevent changing VM and bp from keyboard
		MADDRL = DoingLoad ? AddToVM(MADDRL,DVec),
			LookUpAA(MADDRL,DVec)
		if MADDRL < 0 then resultis false	//Not in VM
case IMXx:	wrtmi(MADDRL,DVec); endcase
case RMx:	unless Initialized do MidasSwat(KernelRM)
		wrtrr(MADDRL,DVec); endcase
case Tx:	wrtt(MADDRL,DVec); endcase
case TPCx:	DV1!0 = MakeAA(DVec!0 rshift 4)
		wrttpc(MADDRL,DV1); endcase
case VMx:	MADDRL = setupmm(AVec,DVec)
		test (MADDRL & #140000) eq 0
		ifso
		[ wrtrr(MADDRL,DVec)
		  sendbyte(EXOVLcode); sendbyte(WRITEMsubcode); endcase
		]
		ifnot resultis false
case MAPx:	wrtmap(MADDRL,DVec);endcase
case MIMx:	GenCorrPar(DVec); MBlock(MADDRL,DVec,3); endcase
case MDATAx:	MADDRL!2 = DVec!2 & #170000
case MADDRx:	MBlock(MADDRL,DVec,2); endcase
default:	resultis false
	]
	 resultis true
]


//Extension arg not presently used for D0 Midas
and MPutMemData(MemX,DataVec,AVec,Extension) be
[	MPutChecks(MEMCON!MemX)	//Will ErrorAbort(..) if illegal
	unless PutMemData(MemX,DataVec,AVec) do ErrorAbort(stUndAdr) 
	UpdateMPDValues()
]


and GenCorrPar(DVec) be
[	unless OddParity(DVec!0 xor DVec!1,DVec!2 & #170000) do
		DVec!1 = DVec!1 xor 1
]

and readmi(Addr,DVec) be
[	sendbyte(sovlput(d0rdmi))
	sendword(Addr % #170000)
	DVec!0 = recvword()
	DVec!1 = recvword()
	DVec!2 = (recvbyte() lshift 8) & #170000
]


and wrtmi(Addr,DVec) be
[	sendbyte(WRTMIcode)
	sendword(Addr % #170000)
	sendbyte(1)	//count = 1
	GenCorrPar(DVec)
	sendword(DVec!0)
	sendword(DVec!1)
	sendbyte(DVec!2 rshift 12)
]



and sovlput(sovl) = valof
[	if (sovlcurr ne sovl!0) do
	[ sovlcurr = sovl!0
	  sendbyte(WRTMIcode)
	  sendword(#177500)
	  sendbyte(sovl!1)
//Parity in MIM has already been fixed
	  for i = 0 to 3*(sovl!1-1) by 3 do
	  [ let p = sovl!2 + i
	    sendword(p!0)
	    sendword(p!1)
	    sendbyte(p!2 rshift 12)
	  ]
	]
	resultis EXOVLcode
]


and readrr(Addr,DVec) be
[
	//must check for Addr = 0, 17 and use overlay if it is
	let code = selecton Addr into
	[
	  case 0: 0
	  case 17b: 1
	  default: -1
	]
	test code ls 0
	ifso
	[ sendbyte(READRcode)
	  sendbyte(Addr)
	  DVec!0 = recvword()
	]
	ifnot
	[ sendbyte(sovlput(d0rsr))
	  sendbyte(code)
	  DVec!0 = recvword()
	]
]


and wrtrr(Addr,DVec) be
[	//must check for Addr = 0, 17 and use overlay if it is
	let code = selecton Addr into
	[
	  case 0: 0
	  case 17b: 1
	  default: -1
	]
	test code ls 0
	ifso
	[ sendbyte(WRITRcode)
	  sendbyte(Addr)
	  sendword(DVec!0)
	]
	ifnot
	[ sendbyte(sovlput(d0wsr))
	  sendbyte(code)
	  sendword(DVec!0)
	]
]


and wrtt(Addr,DVec) be
[	sendbyte(sovlput(d0wrtt))
	sendbyte(Addr)
	sendword(DVec!0)
]


and readt(Addr,DVec) = valof
[	sendbyte(sovlput(d0rdt))
	sendbyte(Addr)
	DVec!0 = recvword()
]


and readtpc(Addr,DVec) = valof
[	sendbyte(sovlput(d0rdtpc))
	sendbyte(Addr)
	DVec!0 = recvword() & #7777
	
]


and wrttpc(Addr,DVec) be
[	let SavedInst = vec 3
//To get TPC[Addr] written with L, we must execute a call from location L-1
//(with carries suppressed appropriately)
	let x = DVec!0  //12-bit address that we want in TPC
	let Loc = (x & 7760b) % (((x & 17b) -1) & 17b) //this is the place from which we must call
	let nLoc = (Addr lshift 12) + Loc //notify word for Loc
	readmi(Loc,SavedInst) //pick up the instruction
	wrtmi(Loc,table [ #50; #25214; #10000 ] ) //callp[RetLoc]
	wrtrr(stack0,lv nLoc) //set up stack0 for the overlay
	sendbyte(sovlput(d0wrttpc)) //do the write
	wrtmi(Loc,SavedInst) //restore the original instruction
]


and setupmm(AVec,DVec) = valof
[	let a0 = (AVec!0) % (AVec!0 lshift 8)
	let a1 = (AVec!1) & #177774
	let a2,a3,DVec1 = nil,nil,vec 1
	sovlput(d0mem)
	wrtrr(stack5,lv a0) //RM 65 (odd base register)
	wrtrr(stack4,lv a1) //RM 64 (even base register)
//Ensure that MAP entry is valid before attempting read or write.
	sendbyte(EXOVLcode)
	sendbyte(XMAPsubcode)
	readrr(stack1,lv a2)
	readrr(stack3,lv a3)
	DVec1!0 = not ((a3 lshift 8)+(a2 & #377))
//Restore MAP from the XMap which smashed it.
	wrtrr(stack0,DVec1)
	sendbyte(EXOVLcode)
	sendbyte(XMAPsubcode)
//DVec1!0 bit 1 is WP, bit 2 is Dirty; return address for readrr or wrtrr if
//both read and write are ok, word address + #40000 if only read is ok,
//negative if MAP indicates vacant.
	switchon (DVec1!0 rshift 13) & 3 into
	[ case 0:
	  case 1:
	  case 2: sendbyte(EXOVLcode); sendbyte(READMsubcode)
		  resultis stack0 + (AVec!1 & 3) + (DVec1!0 & #40000)
	  default: resultis -1
	]
]


and readmap(Addr,DVec) be
[	let a0,a1,a2,a3 = nil,nil,nil,nil
	a0 = (Addr & #177400) % (Addr rshift 8)
	a1 = Addr lshift 8
	sovlput(d0mem)
	wrtrr(stack5,lv a0)
	wrtrr(stack4,lv a1)
	sendbyte(EXOVLcode)
	sendbyte(XMAPsubcode)
	readrr(stack1,lv a2)
	readrr(stack3,lv a3)
	DVec!0 = not ((a3 lshift 8)+(a2 & #377))
	wrtrr(stack0,DVec)
	sendbyte(EXOVLcode)
	sendbyte(XMAPsubcode)
]


and wrtmap(Addr,DVec) be
[	let a0,a1 = nil,nil
	a0 = (Addr & #177400) + (Addr rshift 8)
	a1 = Addr lshift 8
	sovlput(d0mem)
	wrtrr(stack5,lv a0)
	wrtrr(stack4,lv a1)
	wrtrr(stack0,DVec)
	sendbyte(EXOVLcode)
	sendbyte(XMAPsubcode)
]