1 /* ***********************************************************
 2    *                                                         *
 3    * Copyright, (C) Honeywell Information Systems Inc., 1982 *
 4    *                                                         *
 5    *********************************************************** */
 6 %;
 7 /* ******************************************************
 8    *                                                    *
 9    *                                                    *
10    * Copyright (c) 1972 by Massachusetts Institute of   *
11    * Technology and Honeywell Information Systems, Inc. *
12    *                                                    *
13    *                                                    *
14    ****************************************************** */
15 
16 context: proc(name,cblock,type);
17 
18 dcl       (name,cblock,d,p) ptr;
19 dcl       (type,n) fixed bin(15);
20 dcl       (null,string,substr) builtin;
21 
22 %include language_utility;
23 %include context;
24 %include context_codes;
25 %include nodes;
26 %include block;
27 
28                               /*   ^L   */
29 
30 /* this item must be an identifier                          */
31 
32           if name->node.type ^= token_node then go to exit;
33 
34           /* cblock is only null inside a generic <arg selector>.
35              No <reference>s may be contained inside an <arg selector>. */
36 
37           if cblock = null
38           then do;
39                call parse_error(439,name);
40                go to exit;
41                end;
42 
43           p=cblock->block.context;
44           do while(p^=null);
45                     if p->context.token = name then go to record;
46                     p=p->context.next;
47           end;
48 
49           p=create_context(cblock,name);
50 
51 record:
52           substr(string(p->context.bits),type,1) = "1"b;
53 
54 exit:
55           end context;