1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2% 3% File: PXNK:TRAP.SL 4% Description: Signal handling for Aarch64 Linux 5% Author: Vicki O'Day, HP Labs/CRC 6% Created: 27-Feb-84 7% Modified: 2-Jan-85 13:13:16 (Vicki O'Day) 8% Mode: Lisp 9% Package: 10% Status: Open Source: BSD License 11% 12% (c) Copyright 1983, Hewlett-Packard Company, see the file 13% HP_disclaimer at the root of the PSL file tree 14% 15%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 16% 17% Revisions: 18% 19% 17-Feb-89 (Chris Burdorf) 20% Use sun3_sigset for os/4. 21% 09-Oct-87 (Leigh Stoller) 22% Do not call build-trap-message anymore. It is too flakey to be relied 23% on to tell the truth. 24% 31-Apr-87 (Leigh Stoller) 25% After consult with Julian Padget, altered sigunwind to decrease the 26% stack frame by 320 bytes instead of 98. The interrupted address is 27% found 312 bytes into this frame. 28% 18-Aug-86 (Leigh Stoller) 29% Reworked so that signals can be added more easily. Also added calls to 30% external functions which set up the trap, and reinit the trap after a 31% signal is recieved. 32% 2-Jan-85 10:21:47 (Vicki O'Day) 33% Instead of just calling stderror with a message about the kind of trap, 34% we now find the name of the routine that caused the trap and report 35% that as well. CODE-ADDRESS-TO-SYMBOL is used to figure out the name. 36% 27-Dec-84 10:55:56 (Vicki O'Day) 37% Added sigunwind, to pop the signal handler's stack frame before calling 38% stderror. (Many thanks to Jim Davis for deciphering the contents of this 39% frame.) 40% 17-Dec-84 10:24:41 (Vicki O'Day) 41% Added lots more signals to catch, to try to prevent those occasional 42% dumps out of Nmode. 43% 44%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 45 46(fluid '(errornumber* sigaddr* faultaddr* arith-exception-type* stack-pointer* 47 on-altstack* % variable to indicate that we are on an alternate signal stack 48)) 49 50 51(compiletime 52 (progn 53 (setf *sigcalls* nil) 54 % 55 % Create a list of initialization code needed to set up the traps. The 56 % return value is the entry points for each signal handler. 57 % This is later flaged as a 58 % cmacro so the returned code can be inserted directly into the lap coded 59 % procedure 'initializeinterrupts each time it is called. The list 60 % *sigentries is then inserted to define the entry points. 61 (de *sigsetup (signumber function handler errorstring) 62 (setf *sigcalls* (append 63 % Sigset takes a function pointer. 64 `((*move (wconst ,signumber) (reg 1)) 65 (*move ,handler (reg 2)) 66 (*link sun3_sigset expr 2)) 67 *sigcalls*)) 68 % Return the the function definition for the signal handler. 69 `( 70 (*entry ,function expr 0) 71 ,handler 72 (*alloc 0) 73 74 % restore SYMVAL and SYMFNC registers 75 (LDR (reg symval) symval_adr) 76 (LDR (reg symfnc) symfnc_adr) 77 78 % reg 3 contains a pointer to an ucontext_t structre 79 % restore lisp registers x23 (symfnc), x24 (symval), x25 (bndstkptr), 80 % x26 (bndstklowerbound), x27 (bndstkupperbound), x28 (nil) 81% (*move (memory (reg 3) 368) (reg symfnc)) 82% (*move (memory (reg 3) 376) (reg symval)) 83 (*move (memory (reg 3) 384) (reg bndstkptr)) 84 (*move (memory (reg 3) 392) (reg bndstklowerbound)) 85 (*move (memory (reg 3) 400) (reg bndstkupperbound)) 86 (*move (memory (reg 3) 408) (reg nil)) 87 (*move (memory (reg 3) 440) (fluid sigaddr*)) % instruction pointer at fault 88 (*move (memory (reg 3) 432) (fluid stack-pointer*)) % stack pointer at fault 89 (*move (wconst ,signumber) (reg 1)) 90 (*move (reg 1) (fluid errornumber*)) 91 92 % Reg r2 contains a pointer to a siginto_t structure 93 % for SIGILL, SIGFPE, SIGSEGV, SIGBUS, get faulting address (at offset 16 of siginfo_t structure) 94 (*move (memory (reg 2) 16) (fluid faultaddr*)) 95 % for arithmetic expressions, get exception subtype: at offset 8 of siginfo_t structure 96 % there is si_code (4 byte integer) which is the FPE subtype 97 (LDRSW (reg w2) (displacement (reg 2) 8)) 98 (*move (reg 2) (fluid arith-exception-type*)) 99 (*move ,handler (reg 2)) 100 (*link sigrelse expr 2) 101 (*move (quote ,errorstring) (reg 1)) 102 (*dealloc 0) 103 (*jcall sigunwind)) 104 ) 105 106 107 % Return the entry point list. Defined as a cmacro. 108 (de *sigcall () 109 *sigcalls*) 110 111 (defcmacro *sigcall) 112 (defcmacro *sigsetup) 113 114 ) 115) % End of compiletime. 116 117 118(lap '( 119 % (*sigsetup 1 Huphandler Huphandlerinstruction "Hup") 120 (*sigsetup 2 Inthandler IntHandlerInstruction "Interrupt") 121 (*sigsetup 3 QuitHandler QuitHandlerInstruction "Quit") 122 (*sigsetup 4 IllHandler IllHandlerInstruction "Illegal Instruction") 123 (*sigsetup 5 Traphandler TrapHandlerInstruction "Trace Trap") 124 (*sigsetup 6 AbortHandler AbortHandlerInstruction "Program aborted") 125 (*sigsetup 7 Emthandler BusHandlerInstruction "Bus error") 126 (*sigsetup 8 FpeHandler FpeHandlerInstruction "Arithmetic Exception") 127% (*sigsetup 10 Usr1handler Usr1HandlerInstruction "User defined signal 1") 128 (*sigsetup 11 SegHandler SegHandlerInstruction "Segmentation Violation") 129% (*sigsetup 12 Usr2handler Usr2HandlerInstruction "User defined signal 2") 130 (*sigsetup 13 PipeHandler PipeHandlerinstruction "Write on Pipe With Noone to Read") 131 (*sigsetup 14 AlrmHandler AlrmHandlerInstruction "Alarm Clock") 132 (*sigsetup 15 TermHandler TermHandlerInstruction "Termination signal") 133% (*sigsetup 16 STKXhandler STKXHandlerInstruction "Stack fault") 134% (*sigsetup 17 Childhandler ChildHandlerInstruction "Child waiting") 135% (*sigsetup 18 Conthandler ContHandlerInstruction "SIGCONT received") 136% (*sigsetup 20 Stophandler StopHandlerInstruction "SIGTSTP received") 137% (*sigsetup 21 Ttinhandler TtinHandlerInstruction "Bg process waiting for input") 138% (*sigsetup 22 Ttouhandler TtouHandlerInstruction "Bg process waiting for output") 139% (*sigsetup 23 Urghandler UrgHandlerInstruction "Urgent out-of-band data") 140 (*sigsetup 24 CPUXhandler CPUXHandlerInstruction "CPU time limit exceeded") 141 (*sigsetup 25 FileXhandler FileXHandlerInstruction "File size limit exceeded") 142% (*sigsetup 26 VAlrmHandler VAlrmHandlerInstruction "CPU Timer") 143% (*sigsetup 27 ProfHandler ProfHandlerInstruction "Profiling timer") 144% (*sigsetup 28 WinchHandler WinchHandlerInstruction "Window size change") 145% (*sigsetup 29 IOHandler IOHandlerInstruction "IO ready") 146 (*sigsetup 30 Pwrhandler PwrHandlerInstruction "Power failure") 147 (*sigsetup 31 Syshandler SysHandlerInstruction "Bad system call") 148 (*entry initializeinterrupts expr 0) 149 (*alloc 0) 150 (*sigcall) 151 (*exit 0) 152 (*entry init_symval_symfnc expr 0) 153 (ADR (reg t1) symval_adr) 154 (STR (reg symval) (indirect (reg t1))) 155 (ADR (reg t1) symfnc_adr) 156 (STR (reg symfnc) (indirect (reg t1))) 157 (RET) 158 (*entry _set-symval-symfnc expr 0) 159 (LDR (reg symval) symval_adr) 160 (LDR (reg symfnc) symfnc_adr) 161 (RET) 162 symval_adr 163 (fullword 0) 164 symfnc_adr 165 (fullword 0) 166)) 167 168%% store values of symval and symfnc where the signal handler can find them 169(init_symval_symfnc) 170 171%(de initializeinterrupts (nn) 172%% (ieee_flags (strbase (strinf "set")) (strbase (strinf "direction")) 173%% (strbase (strinf "tozero")) 0) 174%% (ieee_handler (strbase (strinf "set")) 175%% (strbase (strinf "common")) 176%% (symfnc (id2int 'fpehandler))) 177%% (*freset) 178%% (initializeinterrupts-1) 179%% (unless (eq 17 nn) (sun3_sigset 500)) % Hack! If stated from top-loop, save 180% the fp environment. 181%) 182 183(lap 184 '((!*entry sigunwind expr 1) 185 % At this point, an arg is already set up in register 1 with a message 186 % describing the kind of trap. 187 188 (*alloc 1) 189 (*move (reg 1) (frame 1)) 190 (*move 256 (reg nil)) 191 (*mkitem (reg NIL) id-tag) % make sure (reg nil) contains nil 192 % if this is a terminal interrupt (errornumber* = 2) we check 193 % whether it occured within lisp code. If not, just return. 194 (*jumpnoteq (label in-lisp) (fluid errornumber*) 2) 195 (*move (quote "Terminal Interrupt") (reg 1)) 196 (*call console-print-string) 197 (*call console-newline) 198 (*move (fluid sigaddr*) (reg 1)) 199 (*link codeaddressp expr 1) 200 (!*jumpnoteq (label in-lisp) (reg 1) (quote nil)) 201 (*move (frame 1) (reg 1)) 202 (*exit 1) 203 in-lisp 204% (*link *freset expr 0) 205 (*link initializeinterrupts expr 0) % MK 206 (*move (frame 1) (reg 2)) 207 (*move (fluid errornumber*) (reg 1)) 208 (*move (reg nil) (fluid on-altstack*)) 209 % if the error number = 11 (segmentation violation, 210 % set on-altstack* to t and try to check for stack overflow 211 (*jumpnoteq (label nostackoverflow) (reg 1) 11) 212 (*move (quote t) (fluid on-altstack*)) 213 % if sp + 1024 >= faultaddr* >= sp - 1024, assume a stack overflow 214 (*move ($fluid faultaddr*) (reg 3)) 215 (*WPlus2 (reg 3) 1024) 216 (*jumpwlessp (label nostackoverflow) (reg 3) (fluid stack-pointer*)) 217 (!*WDifference (reg 3) 2048) 218 (*jumpwgreaterp (label nostackoverflow) (reg 3) (fluid stack-pointer*)) 219 (*move (quote "Stack overflow") (reg 2)) 220 nostackoverflow 221 (*move (wconst 0) (reg 3)) 222 (*jumpnoteq (label done) (reg 1) 8) 223 (*move (fluid arith-exception-type*) (reg 3)) 224 done 225 (*wplus2 (reg 1)(wconst 10000)) 226 (*dealloc 1) 227 (*jcall error-trap) 228 )) 229 230%(setq errorcall* (wgetv symfnc (id2int 'errortrap))) 231 232(commentoutcode 233(lap '((*entry *freset expr 0) 234 (*alloc 0) 235 (*move 100000 (reg 5)) 236 lab 237 (*move ($fluid onewordbuffer) (reg 4)) 238 (*wplus2 (reg 5) -1) 239 (*jumpwgreaterp (label lab) (reg 5) 0) 240 241% (fclex) 242% (wait) 243 (*move ($fluid onewordbuffer) (reg 3)) 244 (*move 0 (reg 2)) 245 (*move (reg 2) (displacement (reg 3) 0)) 246 % (fstcw (displacement (reg 3) 0)) 247 % (wait) 248 (*move (displacement (reg 3) 0) (reg 2)) 249% (*wor (reg 2) 2#110000000000) 250 (*wand (reg 2) 2#11111111110010) 251 (*move (reg 2) (displacement (reg 3) 0)) 252 % (fldcw (displacement (reg 3) 0)) 253 % (wait) 254 (*exit 0))) 255) 256 257%% Error subtypes for arithmetic exception 258(define-constant FPE_INTDIV 1) 259(define-constant FPE_INTOVF 2) 260(define-constant FPE_FLTDIV 3) 261(define-constant FPE_FLTOVF 4) 262(define-constant FPE_FLTUND 5) 263(define-constant FPE_FLTRES 6) 264(define-constant FPE_FLTINV 7) 265(define-constant FPE_FLTSUB 8) 266 267%% convert arithmetic error subtype to error message 268(de get-fpe-errmsg (n) 269 (cond 270 ((eq n FPE_INTDIV) "Integer divide by zero") 271 ((eq n FPE_INTOVF) "Integer overflow") 272 ((eq n FPE_FLTDIV) "Floating point divide by zero") 273 ((eq n FPE_FLTOVF) "Floating point overflow") 274 ((eq n FPE_FLTUND) "Floating point underflow") 275 ((eq n FPE_FLTRES) "Floating point inexact result") 276 ((eq n FPE_FLTINV) "Floating point invalid operation") 277 ((eq n FPE_FLTSUB) "Subscript out of range") 278 (t "Arithmetic exception"))) 279 280(de error-trap (errornumber errorstring arithsubtype) 281 (error errornumber 282 (build-trap-message 283 (if (eq errornumber* 8) (get-fpe-errmsg arithsubtype) 284 errorstring) 285 sigaddr*))) 286 287(de build-trap-message (trap-type trap-addr) 288 (let (extra-info) 289 (cond ((funboundp 'code-address-to-symbol) 290 (setf extra-info 291 (bldmsg "%w%x%w%n%w%n%w%n%w" 292 " at address 0x" 293 (inf trap-addr) 294 " :" 295 " the name of the routine that trapped can't be" 296 " reported unless the function CODE-ADDRESS-TO-SYMBOL" 297 " has been defined, by loading ADDR2ID."))) 298 % else, get the name of the offending function 299 ((setf extra-info (code-address-to-symbol (inf trap-addr))) 300 (setf extra-info (bldmsg "%w%w" " in " extra-info))) 301 (t (setf extra-info (bldmsg "%w%x" " at address 0x" (inf trap-addr)))) 302 ) 303 (bldmsg "%w%w" trap-type extra-info))) 304 305(de mask-terminal-interrupt (block?) 306 (mask_signal 2 (if block? 1 0))) 307 308(fluid '(code-address* closest-address* closest-symbol*)) 309 310(de x-code-address-to-symbol (code-address*) 311 (let ((closest-symbol* ()) (closest-address* 0)) 312 (mapobl #'(lambda (symbol) 313 (when (fcodep symbol) 314 (let ((address (inf (getfcodepointer symbol)))) 315 (when (and (ileq address code-address*) 316 (igreaterp address closest-address*)) 317 (setq closest-address* address) 318 (setq closest-symbol* symbol)))))) 319 closest-symbol*)) 320 321(de code-address-to-symbol (ad) 322 (and (wlessp ad nextbps) (x-code-address-to-symbol ad))) 323 324% End of file. 325 326