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 create_label:
17      proc (cblock, t, type) returns (ptr);
18                                                             /*        Modified on:        12 October 1970 by P. Green */
19                                                             /*        Modified on:         5 January 1971 by BLW for new node format */
20                                                             /*        Modified on:        April 1977 by RHS for new allocation methods */
21 
22 dcl 1 pl1_nodes_template_$label_template external like label aligned;
23 
24 dcl (cblock, t, t1, p) ptr;
25 dcl  create_identifier entry () returns (ptr);
26 dcl  n fixed bin (15);
27 declare (null, string) builtin;
28 dcl  pl1_stat_$node_uses (32) fixed bin ext;
29 dcl  type bit (3) aligned;
30 
31 %include pl1_tree_areas;
32 %include nodes;
33 %include block;
34 %include label;
35 %include token_list;
36 %include token;
37 
38           if t = null then t1 = create_identifier (); else t1 = t;
39 
40           pl1_stat_$node_uses (15) = pl1_stat_$node_uses (15) + 1;
41 
42           allocate label in (tree_area) set (p);
43 
44           p -> label = pl1_nodes_template_$label_template;
45 
46 
47           if cblock -> block.end_declaration = null
48           then cblock -> block.declaration = p;
49           else cblock -> block.end_declaration -> label.next = p;
50           cblock -> block.end_declaration = p;
51           p -> label.block_node = cblock;
52 
53           p -> label.multi_use = t1 -> token.declaration;   /* push onto multi_use chain */
54           t1 -> token.declaration = p;                      /* .. */
55 
56           string (p -> label.source_id) = string (pl1_stat_$statement_id);
57 
58           p -> label.dcl_type = type;
59 
60           p -> label.token = t1;
61 
62 
63 
64           return (p);
65      end create_label;