// 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 K to kill or 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 "!", // 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 K to kill, 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 ]