1 /* ******************************************************
 2    *                                                    *
 3    *                                                    *
 4    * Copyright (c) 1972 by Massachusetts Institute of   *
 5    * Technology and Honeywell Information Systems, Inc. *
 6    *                                                    *
 7    *                                                    *
 8    ****************************************************** */
 9 
10 code_: proc (n);
11 
12 dcl  n fixed bin;                                           /* error message number */
13 
14 dcl (p, q, called_pt, caller_pt) ptr,
15     (called_size, caller_size) fixed bin,
16      bn bit (18);
17 
18 dcl  cu_$stack_frame_ptr entry returns (ptr),
19      pl1_frame_$name entry (ptr, ptr, fixed bin),
20      math_error_ entry (fixed bin, char (*) aligned, char (*) aligned, ptr);
21 
22 dcl 1 frame based,
23     2 skip (8) ptr,
24     2 back ptr,
25     2 forward ptr,
26     2 return ptr;
27 
28 dcl  called char (called_size) aligned based (called_pt),
29      caller char (caller_size) aligned based (caller_pt);
30 
31           p = cu_$stack_frame_ptr() -> frame.back;
32           bn = baseno (p -> frame.return);
33 
34           do while (baseno (p -> frame.return) = bn);
35                p = p -> frame.back;
36           end;
37 
38           q = p -> frame.forward;
39 
40           call pl1_frame_$name (p, caller_pt, caller_size);
41           call pl1_frame_$name (q, called_pt, called_size);
42 
43           call math_error_ (n, (caller), called, p -> frame.return);
44 
45      end;