1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20 tree_manager$init: proc (abort_label_par);
21
22 dcl abort_label_par label;
23
24 dcl abort_label label internal static;
25
26 dcl pl1_stat_$condition_index fixed bin (31) ext static,
27 pl1_stat_$root ptr ext static,
28 pl1_stat_$free_ptr (18) ptr ext static;
29
30 dcl sys_info$max_seg_size ext static fixed bin (35);
31
32 dcl i fixed bin (17);
33 dcl code fixed bin (35);
34
35
36 dcl first_time bit (1) aligned internal static init ("1"b);
37
38 dcl (null, addr, ptr, substr, unspec) builtin;
39
40
41 dcl define_area_ external entry (ptr, fixed bin (35)),
42 release_area_ external entry (ptr),
43 ioa_ entry options (variable);
44
45 %include area_info;
46 %include pl1_tree_areas;
47
48 dcl 1 my_area_info like area_info internal static;
49
50
51 %include token_list;
52 %include source_list;
53
54 abort_label = abort_label_par;
55
56 if pl1_stat_$tree_area_ptr ^= null
57 then call release_area_ (pl1_stat_$tree_area_ptr);
58
59 if pl1_stat_$xeq_tree_area_ptr ^= null
60 then call release_area_ (pl1_stat_$xeq_tree_area_ptr);
61
62
63 if first_time
64 then do;
65 unspec (my_area_info) = "0"b;
66 my_area_info.version = 1;
67 my_area_info.extend = "1"b;
68 my_area_info.no_freeing = "1"b;
69 my_area_info.owner = "pl1";
70 my_area_info.size = sys_info$max_seg_size;
71 first_time = "0"b;
72 end;
73
74
75 my_area_info.areap = null;
76
77 call define_area_ (addr (my_area_info), code);
78
79 if code ^= 0
80 then goto call_failed;
81
82 pl1_stat_$tree_area_ptr = my_area_info.areap;
83
84 allocate source_list in (tree_area) set (pl1_stat_$source_list_ptr);
85
86 allocate token_list in (tree_area) set (pl1_stat_$token_list_ptr);
87
88 my_area_info.areap = null;
89
90 call define_area_ (addr (my_area_info), code);
91
92 if code ^= 0
93 then goto call_failed;
94
95 pl1_stat_$xeq_tree_area_ptr = my_area_info.areap;
96
97 tr:
98 do i = 1 to 18;
99 pl1_stat_$free_ptr (i) = null;
100 end;
101
102 pl1_stat_$condition_index = 0;
103
104 return;
105
106 call_failed:
107 call ioa_ ("Compiler failed in allocating temporary storage.");
108 goto abort_label;
109
110 tree_manager$truncate: entry;
111
112 pl1_stat_$root = null;
113 if pl1_stat_$tree_area_ptr ^= null
114 then call release_area_ (pl1_stat_$tree_area_ptr);
115 if pl1_stat_$xeq_tree_area_ptr ^= null
116 then call release_area_ (pl1_stat_$xeq_tree_area_ptr);
117
118 goto tr;
119
120 end;