1-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. 2-- All rights reserved. 3-- 4-- Redistribution and use in source and binary forms, with or without 5-- modification, are permitted provided that the following conditions are 6-- met: 7-- 8-- - Redistributions of source code must retain the above copyright 9-- notice, this list of conditions and the following disclaimer. 10-- 11-- - Redistributions in binary form must reproduce the above copyright 12-- notice, this list of conditions and the following disclaimer in 13-- the documentation and/or other materials provided with the 14-- distribution. 15-- 16-- - Neither the name of The Numerical ALgorithms Group Ltd. nor the 17-- names of its contributors may be used to endorse or promote products 18-- derived from this software without specific prior written permission. 19-- 20-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS 21-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED 22-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A 23-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER 24-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 25-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 26-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 27-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 28-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 29-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 30-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 32)package "BOOT" 33 34-- This file contains the error printing code used in BOOT and SPAD. 35-- While SPAD only calls "error" (which is then labeled as an algebra 36-- error, BOOT calls "userError" and "systemError" when a problem is 37-- found. 38-- 39-- The variable $BreakMode is set using the system command )set breakmode 40-- and can have one of the values: 41-- break -- always enter a lisp break when an error is signalled 42-- nobreak -- do not enter lisp break mode 43-- query -- ask the user if break mode should be entered 44-- quit -- quit on error with exit status 1 45 46DEFPARAMETER($SystemError, 'SystemError) 47DEFPARAMETER($UserError, 'UserError) 48DEFPARAMETER($AlgebraError, 'AlgebraError) 49 50DEFVAR($timedNameStack) 51 52BUMPCOMPERRORCOUNT() == nil 53 54argumentDataError(argnum, condit, funname) == 55 msg := ['"The test",:bright pred2English condit,'"evaluates to", 56 :bright '"false",'%l,'" for argument",:bright argnum,_ 57 '"to the function",:bright funname,'"and this indicates",'%l,_ 58 '" that the argument is not appropriate."] 59 errorSupervisor($AlgebraError,msg) 60 61queryUser msg == 62 -- display message and return reply 63 sayBrightly msg 64 read_line _*TERMINAL_-IO_* 65 66-- errorSupervisor is the old style error message trapper 67 68errorSupervisor(errorType,errorMsg) == 69 $BreakMode = 'trapSpadErrors => THROW('trapSpadErrors, $numericFailure) 70 errorSupervisor1(errorType,errorMsg,$BreakMode) 71 72errorSupervisor1(errorType,errorMsg,$BreakMode) == 73 BUMPCOMPERRORCOUNT() 74 errorLabel := 75 errorType = $SystemError => '"System error" 76 errorType = $UserError => '"Apparent user error" 77 errorType = $AlgebraError => 78 '"Error detected within library code" 79 STRINGP errorType => errorType 80 '"Error with unknown classification" 81 msg := 82 errorMsg is ['mathprint, :.] => errorMsg 83 not PAIRP errorMsg => ['" ", errorMsg] 84 splitmsg := true 85 if member('%b,errorMsg) then splitmsg := nil 86 else if member('%d,errorMsg) then splitmsg := nil 87 else if member('%l,errorMsg) then splitmsg := nil 88 splitmsg => rest [:['%l, '" ", u] for u in errorMsg] 89 ['" ",:errorMsg] 90 sayErrorly(errorLabel, msg) 91 handleLispBreakLoop($BreakMode) 92 93handleLispBreakLoop($BreakMode) == 94 TERPRI() 95 -- The next line is to try to deal with some reported cases of unwanted 96 -- backtraces appearing, MCD. 97 ENABLE_BACKTRACE(nil) 98 $BreakMode = 'break => 99 sayBrightly '" " 100 BREAK() 101 $BreakMode = 'query => 102 gotIt := nil 103 while not gotIt repeat 104 gotIt := true 105 msgQ := 106 ['%l,'" You have three options. Enter:",'%l,_ 107 '" ",:bright '"continue",'" to continue processing,",'%l,_ 108 '" ",:bright '"top ",'" to return to top level, or",'%l,_ 109 '" ",:bright '"break ",'" to enter a LISP break loop.",'%l,_ 110 '%l,'" Please enter your choice now:"] 111 x := STRING2ID_N(queryUser(msgQ), 1) 112 x := 113 selectOptionLC(x,'(top break continue),NIL) 114 null x => 115 sayBrightly bright '" That was not one of your choices!" 116 gotIt := NIL 117 x = 'top => returnToTopLevel() 118 x = 'break => 119 $BreakMode := 'break 120 sayBrightly ['" Enter",:bright '":C", 121 '"when you are ready to continue processing where you ",'%l,_ 122 '" interrupted the system, enter",:bright '"(TOP)",_ 123 '"when you wish to return",'%l,'" to top level.",'%l,'%l] 124 BREAK() 125 sayBrightly 126 '" Processing will continue where it was interrupted." 127 THROW('SPAD_READER, nil) 128 $BreakMode = 'resume => 129 returnToReader() 130 $BreakMode = 'throw_reader => THROW('SPAD_READER, nil) 131 $BreakMode = 'quit => 132 EXIT_-WITH_-STATUS(1) 133 returnToTopLevel() 134 135TOP() == returnToTopLevel() 136 137returnToTopLevel() == 138 SETQ(CHR, "ENDOFLINECHR") 139 SETQ(TOK, 'END_UNIT) 140 TOPLEVEL() 141 142TOPLEVEL() == 143 THROW('top_level, 'restart) 144 145returnToReader() == 146 not $ReadingFile => returnToTopLevel() 147 sayBrightly ['" Continuing to read the file...", '%l] 148 THROW('SPAD_READER, nil) 149 150sayErrorly(errorLabel, msg) == 151 sayErrorly1(errorLabel, msg) 152 153sayErrorly1(errorLabel, msg) == 154 sayBrightly '" " 155 if $testingSystem then sayMSG $testingErrorPrefix 156 sayBrightly ['" >> ",errorLabel,'":"] 157 m := msg 158 msg is ['mathprint, mathexpr] => 159 mathprint mathexpr 160 sayBrightly msg 161 162-- systemError is being phased out. Please use keyedSystemError. 163systemError(x) == errorSupervisor($SystemError, x) 164 165userError x == errorSupervisor($UserError,x) 166 167error(x) == errorSupervisor($AlgebraError,x) 168 169nice_failure_msg(val, branch, umode) == 170 uname := devaluate(umode) 171 of1 := coerceUn2E(val, uname); 172 str1 := prefix2String(of1); 173 STRCONC(str1, 174 '" of mode ", outputDomainConstructor(umode), 175 '" cannot be coerced to mode ", 176 outputDomainConstructor(branch)) 177 178check_union_failure_msg(val, branch, umode) == 179 got_str1 := false 180 CATCH('top_level, CATCH('SPAD_READER, ( 181 str1 := nice_failure_msg(val, branch, umode); 182 got_str1 := true))) 183 got_str1 => str1 184 str1 := MAKE_REASONABLE(STRINGIMAGE(val)) 185 STRCONC(str1, 186 '" of mode ", STRINGIMAGE(devaluate(umode)), 187 '" cannot be coerced to mode ", 188 STRINGIMAGE(devaluate(branch))) 189 190coerce_failure_msg(val, submode, mode) == 191 check_union_failure_msg(val, submode, mode) 192 193IdentityError(op) == 194 error(["No identity element for reduce of empty list using operation",op]) 195 196throwMessage(:msg) == 197 if $compilingMap then clearCache $mapName 198 msg' := mkMessage concatList msg 199 sayMSG msg' 200 if $printMsgsToFile then sayMSG2File msg' 201 spadThrow() 202