// SwatErrorFile.bcpl - Error message printer.
// Copyright Xerox Corporation 1979, 1982
// Last modified April 22, 1982  3:36 PM by Boggs

get "Streams.d"
get "Swat.decl"

external
[
// outgoing procedures
UserPrintError; PrintError

// incoming procedures from Swat
EventReport
VMFetch; PrintSwateeString
SetFailPt; UnSetFailPt

// incoming procedures from OS
OpenFile; Ws; Wss; PutTemplate; Usc
Closes; Gets; Endofs; Resets; Puts

// incoming statics
dsp
]

structure SERSoft:
[
@SERHead
args↑0,3 word
filename↑0,19 word
]
manifest
[
lenSERSoft = size SERSoft/16
numSERSoftArgs = 4
lenSERSoftFn = 20
]

//----------------------------------------------------------------------------
let UserPrintError() be
//----------------------------------------------------------------------------
// Fetches info from user address space, then calls print error
// Convention is:
//	userAC0 contains pointer to BCPL string for file name
//	userAC1 contains pointer to table [ errcode; p1; p2; p3; ... ]
// If the high order bit of errcode is on, clear the swat screen first
//     -- so really error numbers run from 0 to 32000
[
let errVec = vec lenSERSoft
errVec>>SERSoft.type = serTypeSoft
errVec>>SERSoft.AltoVersion = (table [ 61014b; 1401b ])()
errVec>>SERSoft.OsVersion = VMFetch(VMFetch(176777b)+23b) //23rd top OS static

let p = VMFetch(userAC1)		// -> errCode, arg1, arg2, arg3, arg4
for i = 0 to numSERSoftArgs-1 do
   errVec>>SERSoft.args↑i = VMFetch(p+i)
if (errVec>>SERSoft.args↑0 & 100000b) ne 0 then
   [
   Resets(dsp)
   errVec>>SERSoft.args↑0 = errVec>>SERSoft.args↑0 & 77777b
   ]

p = VMFetch(userAC0)		// -> error file name
for i = 0 to lenSERSoftFn-1 do
   errVec>>SERSoft.filename↑i = VMFetch(p+i)

if PrintError(dsp, lv errVec>>SERSoft.filename, UserErrorFetch) then
   EventReport(errVec, lenSERSoft)
]

//----------------------------------------------------------------------------
and UserErrorFetch(arg) =
   Usc(arg, 10) ls 0? VMFetch(VMFetch(userAC1)+arg), VMFetch(arg)
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and PrintError(stream, fName, Fetch) = valof
//----------------------------------------------------------------------------
// This is called from above to analyze user bugs and
//  from SwatSysErr to analyze Swat bugs, and
//  from SwatCommand to print help messages.
// fName is the putative error file name.
// Fetch is a procedure which takes one arg:
//  0 => fetch error number
//  1-9 => fetch arg 1 through 9
//  anything else => fetch the word at that address
// Returns true if the error should be logged.
//
// An error message in the file is:
// 1. An unsigned decimal number.
// 2. Optionally followed by C (for "Clear" the screen first)
//	or M (print "Type <ctrl>K to kill or <ctrl>P to proceed." after
//	message printed or L to cause error to be logged over Ether.
// 3. Followed by a space.
// 4. Followed by the message text.  To get a parameter printed out, give $
//	followed by a single digit specifying the parameter # (1,2,...),
//      followed optionally by "!<offset>",
//	followed by how to print (o=octal; d=decimal; s=BCPL string)
// 5. End the message text with $$
[
let log = false
let ec = Fetch(0) & 77777b
let message = false
let result = valof
   [
   let found = 0		//file not found
   let s = 0
   SetFailPt(clserrmess)
   s = OpenFile(fName, ksTypeReadOnly, charItem)

   until s eq 0 % Endofs(s) do
      [
      found = 1		//error code not found in the file
      let errCode = 0
      let char = GetNumber(s, 10, lv errCode)
      test errCode eq ec
         ifnot until Endofs(s) do
            if Gets(s) eq $$ & Gets(s) eq $$ break
         ifso
            [
            found = 2		//error code found and printed
            while char ne $*S do
               [
               if char eq $C then Resets(stream)
               if char eq $M then message = true
               if char eq $L then log = true
               char = Gets(s)
               ]

               [
               char = Gets(s)
               test char eq $$
                  ifso
                     [
                     char = Gets(s)
                     if char eq $$ break	//end of message
                     if char eq $' then		//quote char
                        [ Puts(stream, Gets(s)); loop ]
                     let arg = Fetch(char-$0)
                     switchon Gets(s) into
                        [
                        case $d: case $D:
                           [ PutTemplate(stream, "$D", arg); endcase ]
                        case $o: case $O:
                           [ PutTemplate(stream, "$UO", arg); endcase ]
                        case $s: case $S:
                           [ PrintSwateeString(arg, Fetch); endcase ]
                        case $!:
                           [
                           let index = nil
                           char = GetNumber(s, 10, lv index)
                           arg = Fetch(arg+index)
                           docase char
                           ]
                        default: endcase
                        ]
                     ]
                  ifnot Puts(stream, char)
               ] repeatuntil Endofs(s)
            break	//Found & printed message
            ]
      ]
   UnSetFailPt()

   clserrmess:

   if s then Closes(s)
   resultis found
   ]

if message then Wss(stream, "Type <ctrl>K to kill, <ctrl>P to proceed.*N")
if result eq 0 % result eq 1 then
   PutTemplate(stream, "Error number $D called.*N", ec)
if result eq 0 then
   PutTemplate(stream, "Unable to find error file $S*N", fName)
if result eq 1 then
   Wss(stream, "Unable to find the error message in the file.*N")

resultis log
]

//----------------------------------------------------------------------------
and GetNumber(stream, radix, lvNumber) = valof
//----------------------------------------------------------------------------
// Reads characters from stream and treats them as a number in radix
// The number is left in @lvNumber
// Returns the first non-numeric character encountered.
[
let number = 0
let char = nil
until Endofs(stream) do
   [
   char = Gets(stream)
   test char ge $0 & char ls $0 + radix
      ifso number = number*radix + char-$0
      ifnot break
   ]
@lvNumber = number
resultis char
]