// D1LOAD.BCPL -- machine-dependent subroutines called by MLOAD.BCPL
//	Last edited: 2 May 1980

get "mdecl.d"	//**Cannot get d1.d here because of duplicate lh, rh defs.
get "mcommon.d"
manifest [ get "d1regmem.d" ]

external [
// OS
	Zero

// MIDAS
	Initialized

// MASM
	VUsc; StrSize

// MDATA
	MIRPE

// MSYM
	MapSymBlocks; @BHsize

// MMPRGN
	UpdateMPDValues

// MCMD
	DisplayError; ErrorAbort

// MGO
	@CantContinue

// D1TABLES
	@MEMLEN; @MEMWID

// D1ASM
	ReadDMux

// D1VM
	LookUpAA; SetVirtP; RetrieveBlock; VAtab; AAtab
	IMstab; RMstab; BRstab; DEVICEstab; TASKNstab

// Defined here
	PrepareLoad; RestoreAfterLoad; PutMDSymOnly; AddToVM; LoadCleanUp
]

static [ oldMDATAwid ]

//Verify that the hardware is in good shape for the Ld, LdData, LdSyms,
//Cmpr, or Dump and do other setup.  Call DisplayError if probably not
//ok to do the operation; if DisplayError returns (indicating user wants
//to go ahead with the operation), then do ResetsCSS().
let PrepareLoad(SymOnly) be
[	if Initialized & not SymOnly do
	[ CantContinue = CantContinue % didLoad
	  //DisplayError("Power is off", "Continue-loading")
	  //ResetsCSS()
	]
	oldMDATAwid = MEMWID!MDATAx
	MEMWID!MDATAx = MDATAwid
	Zero(MIRPE,2)	//Zero error counters
]


and RestoreAfterLoad() be
[	MEMWID!MDATAx = oldMDATAwid
//Avoid disturbing hardware on LdSyms or during initialization.
	if (CantContinue & didLoad) ne 0 do ReadDMux()
	test LookUpAA(0) ge 0
	ifso SetVirtP(true,nil,nil)
	ifnot if (CantContinue & didLoad) ne 0 then UpdateMPDValues()
	if (MIRPE!0 ne 0) % (MIRPE!1 ne 0) do ErrorAbort("MIR PE's occurred")
]


//Special kludge subroutine used by MLOAD on "LdSyms" because
//the virtual to absolute correspondence table has to be loaded even though
//we are only loading symbols.
and PutMDSymOnly(MemX,DVec,AVec) = valof
[	if MemX eq IMx do
	[ if VUsc(AVec,MEMLEN+MemX+MemX,2) ge 0 then resultis false
	  let AA = AddToVM(AVec!1,DVec)
	  if AA < 0 then resultis false	//AA exceeds phsyical microstore
	]
	resultis true
]


//Called only during Ld, LdSyms, or LdData by PutMemData or PutMDSymOnly.
//VA must be valid.
and AddToVM(VA,DVec) = valof
[ //**Format will change after MicroD is revised to output 14-bit AA's.
	let AA = DVec!3 & #7777
	if AA ge MEMLEN!(IMXx+IMXx+1) then
		ErrorAbort("Abs. addr in IM word too big for IMX")
	let Other = (DVec!3 lshift 2) & #140000
	let Block = RetrieveBlock(VAtab+(VA rshift BlockShift),VAKind,
		2,0,#137777)
	Block!(VA & BlockMask) = AA+Other
	if Other ge 0 do
	[ Block = RetrieveBlock(AAtab+(AA rshift BlockShift),AAKind,
		2,0,#137777)
	  Block!(AA & BlockMask) = VA+Other
	]
	resultis AA
]

//Build IMstab indexed by IM address, contains BlockAddr for the symbol
//block which contains the nearest IM symbol le each IM address.
//Similarly, build RMstab indexed by RM address.
and LoadCleanUp() be
[	if not Initialized then return
	MapSymBlocks(BuildAddrInvert,1)
	let BestBlockAddr = 0
//Fill gaps in IMstab table
	for I = 0 to (MEMLEN!(IMx+IMx+1) rshift (BlockShift+1))-1 do
	[ let Block = RetrieveBlock(IMstab+I,IMKind,1)
	  if Block ne 0 then
		BestBlockAddr = ExtendSyms(BestBlockAddr,Block,BlockSize*2)
	]
	ExtendSyms(0,RMstab,RMlen)
	ExtendSyms(0,BRstab,BRlen)
	ExtendSyms(0,TASKNstab,NTasks)
	ExtendSyms(0,DEVICEstab,DEVICElen)
]


and ExtendSyms(BestBlockAddr,Table,Length) = valof
[	for I = 0 to Length-1 do
	[ let W = Table>>Bytes.Byte↑I
	  test W eq 0
	  ifso Table>>Bytes.Byte↑I = BestBlockAddr
	  ifnot BestBlockAddr = W
	]
	resultis BestBlockAddr
]


//Called from MapSymBlocks.  Fills an IMstab entry for each IM address symbol
//with BlockAddr for the block containing the symbol; fill RMstab entry for
//each RM symbol with BlockAddr for the block containng the symbol.
and BuildAddrInvert(B,nil,nil,nil,nil) be
[	let Block,BlockAddr = B>>BT.Core,B>>BT.BlockAddr
	let Blk = nil
	for I = BHsize to Block>>BH.LastPntr do
	[ let Sym = Block+Block!I
	  let Body = Sym+StrSize(Sym)
	  let Addr = Body>>Symb.A.A2
	  switchon Body!0 into
	  [
case (AddrSymb*#400)+IMx:
	    Blk = RetrieveBlock(IMstab+(Addr rshift (BlockShift+1)),
		IMKind,1,Block,0)
	    Addr = Addr & (BlockMask+BlockMask+1); endcase
case (AddrSymb*#400)+RMx:
	    Blk = RMstab; endcase
case (AddrSymb*#400)+BRx:
	    Blk = BRstab; endcase
case (AddrSymb*#400)+TASKNx:
	    Blk = TASKNstab; endcase
case (AddrSymb*#400)+DEVICEx:
	    Blk = DEVICEstab; endcase
default:    loop
	  ]
	  Blk>>Bytes.Byte↑Addr = BlockAddr
	]
]