1
2
3
4
5
6
7
8
9
10 mrds_space_allocate: proc (mrds_area_ptr, requested_word_size) returns (ptr);
11
12
13
14
15
16
17
18
19
20
21 dcl mrds_area_ptr ptr;
22 dcl requested_word_size fixed bin (35);
23
24 dcl actual_allocated_size fixed bin (35);
25 dcl MRDS_AREA char (8) init ("MRDSAREA");
26 dcl (mod, null, ptr) builtin;
27
28 dcl 1 mrds_area based (mrds_area_ptr),
29 2 area_id char (8),
30 2 offset_to_free_word fixed bin (35),
31 2 length_free_space fixed bin (35);
32
33 dcl p_work_area area (sys_info$max_seg_size) based (mrds_area_ptr);
34 dcl alloc_value_ptr ptr;
35 dcl alloc_value (actual_allocated_size) bit (36) based (alloc_value_ptr);
36
37
38
39 actual_allocated_size = requested_word_size + mod (requested_word_size, 2);
40 if mrds_area_ptr = null then return (null);
41 else if mrds_area.area_id ^= MRDS_AREA then do;
42
43 allocate alloc_value set (alloc_value_ptr) in (p_work_area);
44 return (alloc_value_ptr);
45 end;
46 else if actual_allocated_size <= length_free_space then do;
47
48 alloc_value_ptr = ptr (mrds_area_ptr, mrds_area.offset_to_free_word);
49
50 mrds_area.offset_to_free_word = mrds_area.offset_to_free_word + actual_allocated_size;
51
52 mrds_area.length_free_space = mrds_area.length_free_space - actual_allocated_size;
53 return (alloc_value_ptr);
54 end;
55 else return (null);
56
57
58 end mrds_space_allocate;
59
60