/****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4,insnl,delnl,ifthendo */ sct_manager_$call_handler: proc (mcptr, cname, info_ptr, wc_ptr, continue) options (support); /* This procedure manages the SCT (System Condition Table). Entries are provided for setting and getting the value of an entry in the SCT. (An entry in the SCT is merely a procedure entry pointer.) An entry is also provided for use by the signal_ procedure to call to check if a particular condition has a static handler enabled. Static handlers are not general and should be used with caution. Initial coding: 4/75 S. Webber Modified July 1981 Benson I. Margulies to set the support bit. Modified September 1981 Benson I. Margulies for info_ptr. */ /* Parameters */ dcl continue bit (1) aligned; dcl code fixed bin (35); dcl cname char (*); /* condition name */ dcl (info_ptr, wc_ptr) ptr; dcl mcptr ptr; /* pointer to machine conditions passed from signal_ */ dcl handler ptr; /* entry pointer for handler being set */ dcl fcode fixed bin; /* FIM fault code, used to index into SCT */ /* Automatic */ dcl entry_variable entry (pointer, character (*), pointer, pointer, bit (1) aligned) variable; dcl sp ptr; dcl sct_ptr ptr; /* Based */ dcl 1 entry aligned, 2 ep ptr, 2 environment ptr; dcl ptr_array (0:127) ptr unaligned based; /* External */ dcl error_table_$argerr fixed bin (35) external; /* Constants */ dcl (addr, baseptr, bin, hbound, null, ptr, unspec) builtin; %include stack_header; %include mc; /* Entry to call_handler entry */ call get_sct_ptr; /* get SCT pointer from stack header */ if sct_ptr = null then goto no; if unspec (sct_ptr -> ptr_array (bin (mcptr -> mc.fcode, 17))) = "0"b then do; no: continue = "1"b; /* return so stack will be searched */ return; end; if sct_ptr -> ptr_array (bin (mcptr -> mc.fcode, 17)) = null then goto no; entry.ep = sct_ptr -> ptr_array (bin (mcptr -> mc.fcode, 17)); entry.environment = null; unspec (entry_variable) = unspec (entry); /* Legal PL/1 ! */ call entry_variable (mcptr, cname, info_ptr, wc_ptr, continue); /* call the handler, it sets continue */ return; /**** Entry to set entry */ set: entry (fcode, handler, code); call get_sct_ptr; /* get SCT pointer from stack header */ if sct_ptr = null then goto badx; if fcode < 0 | fcode > hbound (sct_ptr -> ptr_array, 1) then do; badx: code = error_table_$argerr; return; end; sct_ptr -> ptr_array (fcode) = handler; code = 0; return; /* */ /* Entry to get entry */ get: entry (fcode, handler, code); call get_sct_ptr; /* get SCT pointer from stack header */ if sct_ptr = null then goto badx; if fcode < 0 | fcode > hbound (sct_ptr -> ptr_array, 1) then goto badx; handler = sct_ptr -> ptr_array (fcode); if unspec (handler) = ""b then handler = null (); code = 0; return; get_sct_ptr: proc; /* subroutine to get SCT pointer from stack header */ sct_ptr = stackbaseptr () -> stack_header.sct_ptr;/* extract SCT pointer */ return; end; end sct_manager_$call_handler;