Implement NTH.
[muddle-interpreter.git] / src / alloc.c
1 /*
2 Copyright (C) 2017-2018 Keziah Wesley
3
4 You can redistribute and/or modify this file under the terms of the
5 GNU Affero General Public License as published by the Free Software
6 Foundation, either version 3 of the License, or (at your option) any
7 later version.
8
9 This file is distributed in the hope that it will be useful, but
10 WITHOUT ANY WARRANTY; without even the implied warranty of
11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 Affero General Public License for more details.
13
14 You should have received a copy of the GNU Affero General Public
15 License along with this file. If not, see
16 <http://www.gnu.org/licenses/>.
17 */
18
19 #include "alloc.h"
20 #include "atom.h"
21 #include "object.h"
22
23 extern pool_object *pool;
24 extern pool_ptr ptop;
25
26 extern object *vhp_base;
27 extern heap_ptr vhp;
28
29 pool_ptr
30 pool_alloc (uint32_t len)
31 {
32   pool_ptr p = ptop;
33   ptop += len;
34   return p;
35 }
36
37 pool_object *
38 POOL_OBJECT (pool_ptr p)
39 {
40   if (!p)
41     return (pool_object *) 0;
42   return &pool[p];
43 }
44
45 pool_ptr
46 pool_copy_array (const pool_object * objs, uint32_t len)
47 {
48   if (!len)
49     return 0;
50   pool_ptr p = pool_alloc (len);
51   for (int i = 0; i < len; i++)
52     {
53       pool[p + i] = (pool_object)
54       {
55       .type = objs[i].type,.rest = p + i + 1,.val = objs[i].val};
56     }
57   pool[p + len - 1].rest = 0;
58   return p;
59 }
60
61 pool_ptr
62 pool_copy_array_rev (const pool_object * objs, uint32_t len)
63 {
64   if (!len)
65     return 0;
66   pool_ptr p = pool_alloc (len);
67   for (int i = 0; i < len; i++)
68     {
69       pool[p + i] = (pool_object)
70       {
71       .type = objs[len - i - 1].type,.rest = p + i + 1,.val =
72           objs[len - i - 1].val};
73     }
74   pool[p + len - 1].rest = 0;
75   return p;
76 }
77
78 object *
79 HEAP_OBJECT (heap_ptr p)
80 {
81   assert (p > 0);
82   return &vhp_base[p];
83 }
84
85 heap_ptr
86 heap_alloc (uint32_t len)
87 {
88   enum
89   { DOPE_LEN = 1 };
90   heap_ptr p = vhp;
91   vhp += len + DOPE_LEN;
92   return p;
93 }
94
95 heap_ptr
96 heap_copy_array_rev (const object * objs, uint32_t len)
97 {
98   heap_ptr p = heap_alloc (len);
99   object *xs = HEAP_OBJECT (p);
100   for (int i = 0; i < (int) len; i++)
101     {
102       xs[i] = objs[len - 1 - (unsigned) i];
103     }
104   return p;
105 }
106
107 uv_val *
108 UV_VAL (heap_ptr p)
109 {
110   assert (p > 0);
111   return (uv_val *) & vhp_base[p];
112 }
113
114 atom_body *
115 ATOM_BODY (heap_ptr p)
116 {
117   assert (p);
118   return (atom_body *) (&vhp_base[p]);
119 }