// MDerr.bcpl -- error printout for MicroD
// last edited February 2, 1981  2:57 PM

	get "mddecl.d"

external [	// defined here
	Err	// (code, str, par1, ..., parn)
	PutBlanks	// (str, n)
	PutName	// (str, ptr)
	PutAddress	// (str, addr)
	PutSymAddr	// (str, ptr/0, diff/0)
	GetSource	// (addr) -> source/0
	PutFileName	// (str, name) -> nchars
	PutRing	// (str, addr)
	PutAddrData	// (str, addr)
	Show	// (mem, first, last, width, s, format)
		// statics
	ErrHeaderProc	// (str)
]

external [
		// OS
	Puts; Wss; Wos
	CallSwat
		// Template
	PutTemplate
		// MDmain
	@IP
	End
	@ErrDspS
	AbortCode; NErrors; NWarnings; errMax
	@SaveW2; @NInstructions
	@Symbols; @SymLength
	SourceFiles
]


static [ ErrHeaderProc = 0; lastSource = -1 ]


let Err(Code, Str, par1, par2, par3, par4, par5, par6, par7, par8, par9, par10, par11, par12) be
[	let s = ""
	switchon Code into
	[ case Fatal: s = "Fatal error: "
	  case PassFatal: AbortCode = Code
		NErrors = NErrors+1
		endcase
	  case NonFatal:
		s = "Warning: "
		NWarnings = NWarnings+1
	  case PassMessage: endcase
	  default: CallSwat()
	]
	if ErrHeaderProc ne 0 then ErrHeaderProc(ErrDspS)
	Wss(ErrDspS, s)
	PutTemplate(ErrDspS, Str, par1, par2, par3, par4, par5, par6, par7, par8, par9, par10, par11, par12)
	Puts(ErrDspS, $*N)
	if Code eq Fatal then End()
	if NErrors gr errMax then [ Wss(ErrDspS, "Too many errors*N"); End() ]
]

and PutBlanks(s, n) be
	for i = 1 to n do Puts(s, $*S)

and PutName(s, ptr) be
[	let c = ptr>>lh
	if c eq 0 break
	Puts(s, c&177b)
	c = ptr>>rh
	if c eq 0 break
	Puts(s, c&177b)
	if @ptr ls 0 break
	ptr = ptr+1
] repeat

and PutAddress(s, addr) be
[	let mys = GetSource(addr)
	if mys ne 0 then	// only print source file if more than 1
	[ Puts(s, $[)
	  PutFileName(s, mys>>Source.pName)
	  Puts(s, $])
	]
	putaddr(s, addr, mys)
]

and GetSource(addr) = valof
[	test lastSource eq 0
	 ifso resultis 0	// only 1 source
	 ifnot
	if (lastSource ne -1) &
	 (addr ge lastSource>>Source.niFirst) &
	 (addr ls lastSource>>Source.niLast) then
	  resultis lastSource
	let ns, mys = 0, 0
	let s = SourceFiles
	while s ne 0 do
	  [ if s>>Source.niLast gr s>>Source.niFirst then
	    [ ns = ns+1
	      if (addr ge s>>Source.niFirst) & (addr ls s>>Source.niLast) then
	        mys = s
	    ]
	    s = s>>Source.next
	  ]
	lastSource = (ns gr 1? mys, 0)
	resultis lastSource
]

and putaddr(s, addr, source) be
[	// Print symbolic address
	putlabel(s, addr, (source eq 0? 0, source>>Source.niFirst))
	// Print placement information
	let ip = IP(addr)
	if ip>>IM.onPage % ip>>IM.atWord then
	[ Puts(s, $()
	  test ip>>IM.onPage
	  ifso	PutTemplate(s, "$2F0O", ip>>IM.W0 rshift 6)
	  ifnot	Wss(s, "xx")
	  test ip>>IM.atWord
	  ifso	PutTemplate(s, "$2F0O", ip>>IM.W0 & 77B)
	  ifnot	Wss(s, "xx")
	  Puts(s, $))
	]
]

and PutFileName(s, name) = valof
[	let len = name>>BS.length
	  for i = 1 to len do
	  [ let ch = name>>BS.char↑i
	    if ch eq $. resultis i-1
	    Puts(s, ch)
	  ]
	resultis len
]

and putlabel(s, addr, min) be
// Search symbol table for an appropriate label
[	let sbest, dbest = 0, addr-min
	let first = true
	for i = 0 to SymLength-1 do
	[ let sym = Symbols!i
	  while sym ne 0 do
	  [ let diff = addr-(sym!-1)<<Sym.addr
	    if (diff ge 0) & (diff le dbest) & ((sym!-1)<<Sym.memx eq IMmemx) then
	    [ sbest, dbest = sym+1, diff
	      if diff eq 0 then	// print now
	      [ test first
	         ifso [ PutName(s, sbest); first = false ]
	         ifnot [ Wss(s, "(="); PutName(s, sbest); Puts(s, $)) ]
	      ]
	    ]
	    sym = @sym
	  ]
	]
	if first then PutSymAddr(s, sbest, dbest)	// no exact matches
]

and PutSymAddr(s, sbest, dbest) be
[	test sbest ne 0
	 ifso
	[ PutName(s, sbest)
	  if dbest ne 0 then PutTemplate(s, "+$D", dbest)
	]
	 ifnot PutTemplate(s, "$D", dbest)
]

and PutRing(s, addr) be
[	let min = 0	// Put out in increasing address order
	let lasts = 0
	[ let i = ringmin(addr, addr, min)
	  if i eq 10000B break
	  let mys = GetSource(i)
	  if mys ne lasts then
	  [ PutTemplate(s, "   [$P]*N", PutFileName, (s eq 0? ".", mys>>Source.pName))
	    lasts = mys
	  ]
	  Puts(s, $*T)
	  putaddr(s, i, mys)
	  putadata(s, i)
	  Puts(s, $*N)
	  min = i+1
	] repeat
]

and PutAddrData(s, i) be
[	PutAddress(s, i)
	putadata(s, i)
]

and putadata(s, i) be
[	let ip = IP(i)
	if (ip>>IM.atWord eq 0) & (ip>>IM.mask ne -1) then
	  PutTemplate(s, "|$UO", ip>>IM.mask)
	// Following stuff is just to help me debug
	PutTemplate(s, "  [$O: b$C$O", i, (ip>>IM.jbcLinked? $**, $=), ip>>IM.bLink)
	if ip>>IM.aLink ne i then
	  PutTemplate(s, ", a$C$O", (ip>>IM.aLinked? $**, $=), ip>>IM.aLink)
	Puts(s, $])
]

and ringmin(start, stop, min) = valof
[	let i, max = start, 10000B
	[ if (i ge min) & (i ls max) then max = i
	  i = IP(i)>>IM.bLink
	] repeatuntil i eq stop
	resultis max
]


let Show(mem, first, last, width, s, format) be
[	let len1 = format>>BS.length+1
	for i = first to last do
	[ let p = mem+i*width
	  let w, c = i, $;
	  let m = nil
	  for j = 1 to len1 do
	  [ switchon c into
	   [ case $;:
		Wos(s, w)
		if j ne len1 then Wss(s, ", ")
		w = @p
		p, m = p+1, 100000b
		endcase
	     default:
		Puts(s, ((w&m) eq 0? $., c))
		w = w & not m
		m = m rshift 1
	   ]
	    c = format>>BS.char↑j
	  ]
	  Puts(s, $*N)
	]
]