]> git.ipfire.org Git - thirdparty/gcc.git/blame - gcc/m2/gm2-libs/SysStorage.mod
[to-be-committed][RISC-V] Reassociate constants in logical ops
[thirdparty/gcc.git] / gcc / m2 / gm2-libs / SysStorage.mod
CommitLineData
1eee94d3
GM
1(* SysStorage.mod provides dynamic allocation for the system components.
2
a945c346 3Copyright (C) 2001-2024 Free Software Foundation, Inc.
1eee94d3
GM
4Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
5
6This file is part of GNU Modula-2.
7
8GNU Modula-2 is free software; you can redistribute it and/or modify
9it under the terms of the GNU General Public License as published by
10the Free Software Foundation; either version 3, or (at your option)
11any later version.
12
13GNU Modula-2 is distributed in the hope that it will be useful, but
14WITHOUT ANY WARRANTY; without even the implied warranty of
15MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16General Public License for more details.
17
18Under Section 7 of GPL version 3, you are granted additional
19permissions described in the GCC Runtime Library Exception, version
203.1, as published by the Free Software Foundation.
21
22You should have received a copy of the GNU General Public License and
23a copy of the GCC Runtime Library Exception along with this program;
24see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
25<http://www.gnu.org/licenses/>. *)
26
27IMPLEMENTATION MODULE SysStorage ;
28
29FROM libc IMPORT malloc, free, realloc, memset, getenv, printf ;
30FROM Debug IMPORT Halt ;
31FROM SYSTEM IMPORT ADR ;
32
33
34CONST
35 enableDeallocation = TRUE ;
77924dff 36 enableZero = TRUE ;
6bf80413 37 enableTrace = FALSE ;
1eee94d3
GM
38
39VAR
40 callno: CARDINAL ;
41 zero,
42 trace : BOOLEAN ;
43
44
45PROCEDURE ALLOCATE (VAR a: ADDRESS ; size: CARDINAL) ;
46BEGIN
47 a := malloc (size) ;
48 IF a = NIL
49 THEN
77924dff
GM
50 Halt ('out of memory error',
51 __FILE__, __FUNCTION__, __LINE__)
1eee94d3
GM
52 END ;
53 IF enableTrace AND trace
54 THEN
55 printf ("<DEBUG-CALL> %d SysStorage.ALLOCATE (0x%x, %d bytes)\n", callno, a, size) ;
56 printf ("<MEM-ALLOC> %ld %d\n", a, size);
57 INC (callno)
58 END
59END ALLOCATE ;
60
61
62PROCEDURE DEALLOCATE (VAR a: ADDRESS; size: CARDINAL);
63BEGIN
64 IF enableTrace AND trace
65 THEN
66 printf ("<DEBUG-CALL> %d SysStorage.DEALLOCATE (0x%x, %d bytes)\n", callno, a, size) ;
67 INC (callno)
68 END ;
69 IF enableZero AND zero
70 THEN
71 IF enableTrace AND trace
72 THEN
73 printf (" memset (0x%x, 0, %d bytes)\n", a, size)
74 END ;
75 IF memset (a, 0, size) # a
76 THEN
77924dff
GM
77 Halt ('memset should have returned the first parameter',
78 __FILE__, __FUNCTION__, __LINE__)
1eee94d3
GM
79 END
80 END ;
81 IF enableDeallocation
82 THEN
83 IF enableTrace AND trace
84 THEN
85 printf (" free (0x%x) %d bytes\n", a, size) ;
86 printf ("<MEM-FREE> %ld %d\n", a, size);
87 END ;
88 free (a)
89 END ;
90 a := NIL
91END DEALLOCATE ;
92
93
94(*
95 REALLOCATE - attempts to reallocate storage. The address,
96 a, should either be NIL in which case ALLOCATE
97 is called, or alternatively it should have already
98 been initialized by ALLOCATE. The allocated storage
99 is resized accordingly.
100*)
101
102PROCEDURE REALLOCATE (VAR a: ADDRESS; size: CARDINAL) ;
103BEGIN
104 IF a = NIL
105 THEN
106 ALLOCATE (a, size)
107 ELSE
108 IF enableTrace AND trace
109 THEN
110 printf ("<DEBUG-CALL> %d SysStorage.REALLOCATE (0x%x, %d bytes)\n", callno, a, size) ;
111 INC (callno)
112 END ;
113 IF enableTrace AND trace
114 THEN
115 printf (" realloc (0x%x, %d bytes) -> ", a, size) ;
116 printf ("<MEM-FREE> %ld %d\n", a, size)
117 END ;
118 a := realloc (a, size) ;
119 IF a = NIL
120 THEN
77924dff
GM
121 Halt ('out of memory error',
122 __FILE__, __FUNCTION__, __LINE__)
1eee94d3
GM
123 END ;
124 IF enableTrace AND trace
125 THEN
126 printf ("<MEM-ALLOC> %ld %d\n", a, size) ;
127 printf (" 0x%x %d bytes\n", a, size)
128 END
129 END
130END REALLOCATE ;
131
132
133PROCEDURE Available (size: CARDINAL) : BOOLEAN;
134VAR
135 a: ADDRESS ;
136BEGIN
137 IF enableTrace AND trace
138 THEN
139 printf ("<DEBUG-CALL> %d SysStorage.Available (%d bytes)\n", callno, size) ;
140 INC (callno)
141 END ;
142 a := malloc (size) ;
143 IF a = NIL
144 THEN
145 IF enableTrace AND trace
146 THEN
147 printf (" no\n", size)
148 END ;
149 RETURN FALSE
150 ELSE
151 IF enableTrace AND trace
152 THEN
153 printf (" yes\n", size)
154 END ;
155 free (a) ;
156 RETURN TRUE
157 END
158END Available ;
159
160
161(*
162 Init - initializes the heap. This does nothing on a GNU/Linux system.
163 But it remains here since it might be used in an embedded system.
164*)
165
166PROCEDURE Init ;
167END Init ;
168
169
170BEGIN
171 callno := 0 ;
172 IF enableTrace
173 THEN
174 trace := getenv (ADR ("M2DEBUG_SYSSTORAGE_trace")) # NIL
175 ELSE
176 trace := FALSE
177 END ;
178 IF enableZero
179 THEN
180 zero := getenv (ADR ("M2DEBUG_SYSSTORAGE_zero")) # NIL
181 ELSE
182 zero := FALSE
183 END
184END SysStorage.