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 /* Originally coded by Paul Green, July, 1970 */
17 /*        Modified on:         5 January 1971 by BLW for new node format */
18 /*        Modified on:        30 October 1970 by PG for updated node format */
19 /*        Modified on:        14 September 1970 by P. Green for Version II */
20 /*        Modified on:        April 1977 by RHS for new allocation methods */
21 /* This procedure is called to create a symbol table in
22    cblock, pointed to by token, and having the given type.
23    If cblock is null, the symbol is left floating.
24    If token is null, create_identifier is called to produce a
25    uniquely named identifier.  */
26 
27 create_symbol:
28      proc (cblock, token, type) returns (ptr);
29 dcl 1 pl1_nodes_template_$symbol_template external like symbol aligned;
30 
31 dcl (cblock, token, tok_pt, p) pointer,
32      type bit (3) aligned,
33      k fixed bin (21) init (0),                             /* this is used only by the "token" incl file     */
34     (n, nodetype) fixed bin (15);
35 
36 dcl  pl1_stat_$free_ptr (18) ptr ext static;
37 dcl  pl1_stat_$node_uses (32) fixed bin ext;
38 
39 dcl  create_identifier external entry returns (ptr),
40      create_reference$for_symbol external entry (ptr) returns (ptr);
41 
42 dcl (addr, fixed, null, string) builtin;
43 
44 %include pl1_tree_areas;
45 % include symbol;
46 % include block;
47 %include token_list;
48 
49 
50 % include nodes;
51 /* ^LBegin processing */
52 
53           if token = null then tok_pt = create_identifier (); else tok_pt = token;
54 
55           nodetype = fixed (symbol_node, 15, 0);
56           p = pl1_stat_$free_ptr (nodetype);
57 
58           if p ^= null
59           then pl1_stat_$free_ptr (nodetype) = p -> symbol.next;
60           else do;
61                pl1_stat_$node_uses (6) = pl1_stat_$node_uses (6) + 1;
62                allocate symbol in (tree_area) set (p);
63           end;
64           p -> symbol = pl1_nodes_template_$symbol_template;
65 
66           if cblock = null
67           then p -> symbol.block_node = null;
68           else do;
69                p -> symbol.block_node = cblock;
70 
71                if cblock -> block.end_declaration = null
72                then cblock -> block.declaration = p;
73                else cblock -> block.end_declaration -> symbol.next = p;
74 
75                cblock -> block.end_declaration = p;
76           end;
77 
78           p -> symbol.multi_use = tok_pt -> t_table.declaration; /* push this symbol onto multi_use chain */
79           tok_pt -> t_table.declaration = p;                /* update pointer to first symbol */
80 
81           p -> symbol.token = tok_pt;                       /* set pointer back to token table */
82           p -> symbol.dcl_type = type;                      /* assign type as passed to us          */
83           p -> symbol.node_type = symbol_node;              /* identify this node                   */
84 
85           p -> symbol.reference = create_reference$for_symbol (p);
86 
87           return (p);
88 
89      end create_symbol;