1 /* ====== BEGIN INCLUDE SEGMENT         apl_push_stack_fcn.incl.pl1 =============================== */
 2 
 3 /* format: style3 */
 4 apl_push_stack_:
 5      procedure (P_n_words) returns (ptr);
 6 
 7 /* Function to (1) double-word align ws_info.value_stack_ptr, and
 8    (2) make sure allocation request will fit on current value stack.
 9 
10    Written 770413 by PG
11    Modified 780210 by PG to round allocations up to an even number of words.
12 */
13 
14 /* parameters */
15 
16 declare   P_n_words           fixed bin (19) parameter;
17 
18 /* automatic */
19 
20 declare   block_ptr           ptr,
21           num_words           fixed bin (19);
22 
23 /* builtins */
24 
25 declare   (addrel, binary, rel, substr, unspec)
26                               builtin;
27 
28 /* entries */
29 
30 declare   apl_get_value_stack_
31                               entry (fixed bin (19));
32 
33 /* program */
34 
35           num_words = P_n_words;
36 
37           if substr (unspec (num_words), 36, 1) = "1"b      /* num_words odd */
38           then num_words = num_words + 1;
39 
40           if binary (rel (ws_info.value_stack_ptr), 18) + num_words > ws_info.maximum_value_stack_size
41           then call apl_get_value_stack_ (num_words);
42 
43           block_ptr = ws_info.value_stack_ptr;
44           ws_info.value_stack_ptr = addrel (ws_info.value_stack_ptr, num_words);
45           return (block_ptr);
46 
47      end apl_push_stack_;
48 
49 /* ------ END INCLUDE SEGMENT           apl_push_stack_fcn.incl.pl1 ------------------------------- */