// SpruceError.Bcpl -- Error Management Routines
// Not in SpruceUtilsRes because of cross reference/cond. comp. conflicts

get "Spruce.D"
get "SpruceFiles.D"

compileif newname SpruceSw then [ manifest [ SpruceSw = true ] ]
manifest SprintSw = not SpruceSw

// defined here
external
	[
	GetTime
	Scream
	SpruceCondition
	SpruceError
	]

// incoming procedures
external
	[
  // OS
	GotoFrame
	MoveBlock
	MyFrame
	StartIO

  // SpruceUtils
	Comment
	DoBreakPage
	FindErrorMessage
	FSGetRelease

  // SpruceUtilsRes
	IsOverlayPresent
	Min
	SwapSystem
	Umax

  // SpruceUser
	Post

  // SpruceMl
	Usc
	]

// Incoming statics
external
	[
	BandFile
	DebugSystem
	errorPending
	outMsg
	numComments
	numMustPrint
	numPrinted
	printDoc
	printing
	reasonVec
	spooling
	Verbose
	]

let SpruceCondition(code, condition, p1, p2, p3, p4) be
 [
 compiletest SprintSw
  ifso [ // Sprint
  let serious = condition > ECContinue
  if errorPending then [ unless serious return // ignore if worse error already pending
      // ~~ caution: if printer status is also bad, that will not be recorded this time!!
	GotoFrame(errorPending, 0)  ] // Avoid recursive errors!
  let tests = condition&#300
  let sF = p1>>SS.spruceFile
  switchon tests into
	[
	default: endcase
	case ECTestRead: case ECTestBoth:
		if sF>>SPruceFile.fileCode ge FILEPress docase -1
		if tests eq ECTestRead endcase
	case ECTestWrite: unless sF eq BandFile endcase
	case -1: condition = ECFileTerminate // not as fatal
		 code = code+1 // switch to more specific wording
	]
  condition = condition&#77 // throw out demotion requests
  if (condition eq ECWarning) & (not Verbose) return
  errorPending = MyFrame() // context to return to
  outMsg>>TOSpoolerMsg.inProgressCode = // ~~ note use of printDoc static here
	printDoc>>DocG.PressFile>>SPruceFile.fileCode
  MoveBlock(lv outMsg>>TOSpoolerMsg.completionCode, lv code, 6)
  let cond = condition; condition = code
  if (DebugSystem&#1000) eq 0 & (cond eq ECFatal % (DebugSystem&4) ne 0) then
	(table [ #77403; #1401 ])("Spruce.Errors", lv condition)
  let str = vec 50
  if cond le ECFileTerminate & IsOverlayPresent(OVInterpret) then
	[
	FSGetRelease(0) // be sure there's enough space
	if (serious % numComments < maxComments) &
	   FindErrorMessage(lv condition, str, 50, serious) then
		Comment(str, serious)
	// DoBreakPage returns on completion or error
	if cond eq ECFileTerminate then
	  [ numMustPrint = Umax(numMustPrint, numPrinted+1); DoBreakPage() ]
	]
  errorPending = false
  if serious then SwapSystem(cond eq ECEngineTerminate) // if param true, can continue on return
  ]
  ifnot [ // Spruce
  if condition eq ECSpoolTerminate then // post, shut down activities, return
	[
	let str = vec lenErrStr
	condition = code; FindErrorMessage(lv condition, str, lenErrStr)
	Post(0, ECSpoolTerminate, str)
	if spooling then MoveBlock(reasonVec, str, str>>STR.length/2+1)
	spooling, printing = false, false
	unless (DebugSystem&#4000) ne 0 return
	]
  condition = code; (table [ #77403; #1401 ])("Spruce.Errors", lv condition)
  ]
 ]

and SpruceError(code, p1, p2, p3, p4) be SpruceCondition(code, ECFatal, p1, p2, p3, p4)
and Scream(str) be SpruceError(102)

and GetTime(ptr, ref; numargs n) = valof
 [ compileif false then [
	let time=@#430; if n eq 1 then [ @ptr=time-@ptr ]; if n eq 2 then [ @ptr=@ptr+(time-ref) ]
	resultis time ] ]

// DCS, January 21, 1978  12:09 AM, from SpruceUtils,
// March 11, 1978  2:15 PM, reduce possibility of memory crash
// May 15, 1978  8:08 PM, don't let warning prevent break page creation on serious error
// May 15, 1978  9:57 PM, improve break page comment treatments.
// September 1, 1978  10:17 AM, add special error handling of ECSpoolTerminate conditions
// September 1, 1978  10:33 AM, remove Scream, SpruceTrap
// September 1, 1978  1:30 PM, return Scream -- called from Scan
// September 22, 1978  2:27 PM, include error code in message only if serious
// August 6, 1979  4:51 PM, pass bin info back and forth
//