aboutsummaryrefslogtreecommitdiffstats
path: root/passes/memory/memory_map.cc
blob: 65bccb5ef9907965c51f4a7a6e4851b7d7c1251b (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
/*
 *  yosys -- Yosys Open SYnthesis Suite
 *
 *  Copyright (C) 2012  Clifford Wolf <clifford@clifford.at>
 *
 *  Permission to use, copy, modify, and/or distribute this software for any
 *  purpose with or without fee is hereby granted, provided that the above
 *  copyright notice and this permission notice appear in all copies.
 *
 *  THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 *  WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 *  MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 *  ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 *  WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 *  ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 *  OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *
 */

#include "kernel/register.h"
#include "kernel/log.h"
#include <sstream>
#include <set>
#include <stdlib.h>

USING_YOSYS_NAMESPACE
PRIVATE_NAMESPACE_BEGIN

struct MemoryMapWorker
{
	RTLIL::Design *design;
	RTLIL::Module *module;

	std::map<std::pair<RTLIL::SigSpec, RTLIL::SigSpec>, RTLIL::SigBit> decoder_cache;

	std::string genid(RTLIL::IdString name, std::string token1 = "", int i = -1, std::string token2 = "", int j = -1, std::string token3 = "", int k = -1, std::string token4 = "")
	{
		std::stringstream sstr;
		sstr << "$memory" << name.str() << token1;

		if (i >= 0)
			sstr << "[" << i << "]";

		sstr << token2;

		if (j >= 0)
			sstr << "[" << j << "]";

		sstr << token3;

		if (k >= 0)
			sstr << "[" << k << "]";

		sstr << token4 << "$" << (autoidx++);
		return sstr.str();
	}

	RTLIL::Wire *addr_decode(RTLIL::SigSpec addr_sig, RTLIL::SigSpec addr_val)
	{
		std::pair<RTLIL::SigSpec, RTLIL::SigSpec> key(addr_sig, addr_val);
		log_assert(GetSize(addr_sig) == GetSize(addr_val));

		if (decoder_cache.count(key) == 0) {
			if (GetSize(addr_sig) < 2) {
				decoder_cache[key] = module->Eq(NEW_ID, addr_sig, addr_val);
			} else {
				int split_at = GetSize(addr_sig) / 2;
				RTLIL::SigBit left_eq = addr_decode(addr_sig.extract(0, split_at), addr_val.extract(0, split_at));
				RTLIL::SigBit right_eq = addr_decode(addr_sig.extract(split_at, GetSize(addr_sig) - split_at), addr_val.extract(split_at, GetSize(addr_val) - split_at));
				decoder_cache[key] = module->And(NEW_ID, left_eq, right_eq);
			}
		}

		RTLIL::SigBit bit = decoder_cache.at(key);
		log_assert(bit.wire != nullptr && GetSize(bit.wire) == 1);
		return bit.wire;
	}

	void handle_cell(RTLIL::Cell *cell)
	{
		std::set<int> static_ports;
		std::map<int, RTLIL::SigSpec> static_cells_map;

		int wr_ports = cell->parameters["\\WR_PORTS"].as_int();
		int rd_ports = cell->parameters["\\RD_PORTS"].as_int();

		int mem_size = cell->parameters["\\SIZE"].as_int();
		int mem_width = cell->parameters["\\WIDTH"].as_int();
		int mem_offset = cell->parameters["\\OFFSET"].as_int();
		int mem_abits = cell->parameters["\\ABITS"].as_int();

		SigSpec init_data = cell->getParam("\\INIT");
		init_data.extend_u0(mem_size*mem_width, true);

		// delete unused memory cell
		if (wr_ports == 0 && rd_ports == 0) {
			module->remove(cell);
			return;
		}

		// all write ports must share the same clock
		RTLIL::SigSpec clocks = cell->getPort("\\WR_CLK");
		RTLIL::Const clocks_pol = cell->parameters["\\WR_CLK_POLARITY"];
		RTLIL::Const clocks_en = cell->parameters["\\WR_CLK_ENABLE"];
		clocks_pol.bits.resize(wr_ports);
		clocks_en.bits.resize(wr_ports);
		RTLIL::SigSpec refclock;
		RTLIL::State refclock_pol = RTLIL::State::Sx;
		for (int i = 0; i < clocks.size(); i++) {
			RTLIL::SigSpec wr_en = cell->getPort("\\WR_EN").extract(i * mem_width, mem_width);
			if (wr_en.is_fully_const() && !wr_en.as_bool()) {
				static_ports.insert(i);
				continue;
			}
			if (clocks_en.bits[i] != RTLIL::State::S1) {
				RTLIL::SigSpec wr_addr = cell->getPort("\\WR_ADDR").extract(i*mem_abits, mem_abits);
				RTLIL::SigSpec wr_data = cell->getPort("\\WR_DATA").extract(i*mem_width, mem_width);
				if (wr_addr.is_fully_const()) {
					// FIXME: Actually we should check for wr_en.is_fully_const() also and
					// create a $adff cell with this ports wr_en input as reset pin when wr_en
					// is not a simple static 1.
					static_cells_map[wr_addr.as_int() - mem_offset] = wr_data;
					static_ports.insert(i);
					continue;
				}
				log("Not mapping memory cell %s in module %s (write port %d has no clock).\n",
						cell->name.c_str(), module->name.c_str(), i);
				return;
			}
			if (refclock.size() == 0) {
				refclock = clocks.extract(i, 1);
				refclock_pol = clocks_pol.bits[i];
			}
			if (clocks.extract(i, 1) != refclock || clocks_pol.bits[i] != refclock_pol) {
				log("Not mapping memory cell %s in module %s (write clock %d is incompatible with other clocks).\n",
						cell->name.c_str(), module->name.c_str(), i);
				return;
			}
		}

		log("Mapping memory cell %s in module %s:\n", cell->name.c_str(), module->name.c_str());

		std::vector<RTLIL::SigSpec> data_reg_in;
		std::vector<RTLIL::SigSpec> data_reg_out;

		int count_static = 0;

		for (int i = 0; i < mem_size; i++)
		{
			if (static_cells_map.count(i) > 0)
			{
				data_reg_in.push_back(RTLIL::SigSpec(RTLIL::State::Sz, mem_width));
				data_reg_out.push_back(static_cells_map[i]);
				count_static++;
			}
			else
			{
				RTLIL::Cell *c = module->addCell(genid(cell->name, "", i), "$dff");
				c->parameters["\\WIDTH"] = cell->parameters["\\WIDTH"];
				if (clocks_pol.bits.size() > 0) {
					c->parameters["\\CLK_POLARITY"] = RTLIL::Const(clocks_pol.bits[0]);
					c->setPort("\\CLK", clocks.extract(0, 1));
				} else {
					c->parameters["\\CLK_POLARITY"] = RTLIL::Const(RTLIL::State::S1);
					c->setPort("\\CLK", RTLIL::SigSpec(RTLIL::State::S0));
				}

				RTLIL::Wire *w_in = module->addWire(genid(cell->name, "", i, "$d"), mem_width);
				data_reg_in.push_back(RTLIL::SigSpec(w_in));
				c->setPort("\\D", data_reg_in.back());

				std::string w_out_name = stringf("%s[%d]", cell->parameters["\\MEMID"].decode_string().c_str(), i);
				if (module->wires_.count(w_out_name) > 0)
					w_out_name = genid(cell->name, "", i, "$q");

				RTLIL::Wire *w_out = module->addWire(w_out_name, mem_width);
				SigSpec w_init = init_data.extract(i*mem_width, mem_width);

				if (!w_init.is_fully_undef())
					w_out->attributes["\\init"] = w_init.as_const();

				data_reg_out.push_back(RTLIL::SigSpec(w_out));
				c->setPort("\\Q", data_reg_out.back());
			}
		}

		log("  created %d $dff cells and %d static cells of width %d.\n", mem_size-count_static, count_static, mem_width);

		int count_dff = 0, count_mux = 0, count_wrmux = 0;

		for (int i = 0; i < cell->parameters["\\RD_PORTS"].as_int(); i++)
		{
			RTLIL::SigSpec rd_addr = cell->getPort("\\RD_ADDR").extract(i*mem_abits, mem_abits);

			if (mem_offset)
				rd_addr = module->Sub(NEW_ID, rd_addr, SigSpec(mem_offset, GetSize(rd_addr)));

			std::vector<RTLIL::SigSpec> rd_signals;
			rd_signals.push_back(cell->getPort("\\RD_DATA").extract(i*mem_width, mem_width));

			if (cell->parameters["\\RD_CLK_ENABLE"].bits[i] == RTLIL::State::S1)
			{
				RTLIL::Cell *dff_cell = nullptr;

				if (cell->parameters["\\RD_TRANSPARENT"].bits[i] == RTLIL::State::S1)
				{
					dff_cell = module->addCell(genid(cell->name, "$rdreg", i), "$dff");
					dff_cell->parameters["\\WIDTH"] = RTLIL::Const(mem_abits);
					dff_cell->parameters["\\CLK_POLARITY"] = RTLIL::Const(cell->parameters["\\RD_CLK_POLARITY"].bits[i]);
					dff_cell->setPort("\\CLK", cell->getPort("\\RD_CLK").extract(i, 1));
					dff_cell->setPort("\\D", rd_addr);
					count_dff++;

					RTLIL::Wire *w = module->addWire(genid(cell->name, "$rdreg", i, "$q"), mem_abits);

					dff_cell->setPort("\\Q", RTLIL::SigSpec(w));
					rd_addr = RTLIL::SigSpec(w);
				}
				else
				{
					dff_cell = module->addCell(genid(cell->name, "$rdreg", i), "$dff");
					dff_cell->parameters["\\WIDTH"] = cell->parameters["\\WIDTH"];
					dff_cell->parameters["\\CLK_POLARITY"] = RTLIL::Const(cell->parameters["\\RD_CLK_POLARITY"].bits[i]);
					dff_cell->setPort("\\CLK", cell->getPort("\\RD_CLK").extract(i, 1));
					dff_cell->setPort("\\Q", rd_signals.back());
					count_dff++;

					RTLIL::Wire *w = module->addWire(genid(cell->name, "$rdreg", i, "$d"), mem_width);

					rd_signals.clear();
					rd_signals.push_back(RTLIL::SigSpec(w));
					dff_cell->setPort("\\D", rd_signals.back());
				}

				SigBit en_bit = cell->getPort("\\RD_EN").extract(i);
				if (en_bit != State::S1) {
					SigSpec new_d = module->Mux(genid(cell->name, "$rdenmux", i),
							dff_cell->getPort("\\Q"), dff_cell->getPort("\\D"), en_bit);
					dff_cell->setPort("\\D", new_d);
				}
			}

			for (int j = 0; j < mem_abits; j++)
			{
				std::vector<RTLIL::SigSpec> next_rd_signals;

				for (size_t k = 0; k < rd_signals.size(); k++)
				{
					RTLIL::Cell *c = module->addCell(genid(cell->name, "$rdmux", i, "", j, "", k), "$mux");
					c->parameters["\\WIDTH"] = cell->parameters["\\WIDTH"];
					c->setPort("\\Y", rd_signals[k]);
					c->setPort("\\S", rd_addr.extract(mem_abits-j-1, 1));
					count_mux++;

					c->setPort("\\A", module->addWire(genid(cell->name, "$rdmux", i, "", j, "", k, "$a"), mem_width));
					c->setPort("\\B", module->addWire(genid(cell->name, "$rdmux", i, "", j, "", k, "$b"), mem_width));

					next_rd_signals.push_back(c->getPort("\\A"));
					next_rd_signals.push_back(c->getPort("\\B"));
				}

				next_rd_signals.swap(rd_signals);
			}

			for (int j = 0; j < mem_size; j++)
				module->connect(RTLIL::SigSig(rd_signals[j], data_reg_out[j]));
		}

		log("  read interface: %d $dff and %d $mux cells.\n", count_dff, count_mux);

		for (int i = 0; i < mem_size; i++)
		{
			if (static_cells_map.count(i) > 0)
				continue;

			RTLIL::SigSpec sig = data_reg_out[i];

			for (int j = 0; j < cell->parameters["\\WR_PORTS"].as_int(); j++)
			{
				RTLIL::SigSpec wr_addr = cell->getPort("\\WR_ADDR").extract(j*mem_abits, mem_abits);
				RTLIL::SigSpec wr_data = cell->getPort("\\WR_DATA").extract(j*mem_width, mem_width);
				RTLIL::SigSpec wr_en = cell->getPort("\\WR_EN").extract(j*mem_width, mem_width);

				if (mem_offset)
					wr_addr = module->Sub(NEW_ID, wr_addr, SigSpec(mem_offset, GetSize(wr_addr)));

				RTLIL::Wire *w_seladdr = addr_decode(wr_addr, RTLIL::SigSpec(i, mem_abits));

				int wr_offset = 0;
				while (wr_offset < wr_en.size())
				{
					int wr_width = 1;
					RTLIL::SigSpec wr_bit = wr_en.extract(wr_offset, 1);

					while (wr_offset + wr_width < wr_en.size()) {
						RTLIL::SigSpec next_wr_bit = wr_en.extract(wr_offset + wr_width, 1);
						if (next_wr_bit != wr_bit)
							break;
						wr_width++;
					}

					RTLIL::Wire *w = w_seladdr;

					if (wr_bit != State::S1)
					{
						RTLIL::Cell *c = module->addCell(genid(cell->name, "$wren", i, "", j, "", wr_offset), "$and");
						c->parameters["\\A_SIGNED"] = RTLIL::Const(0);
						c->parameters["\\B_SIGNED"] = RTLIL::Const(0);
						c->parameters["\\A_WIDTH"] = RTLIL::Const(1);
						c->parameters["\\B_WIDTH"] = RTLIL::Const(1);
						c->parameters["\\Y_WIDTH"] = RTLIL::Const(1);
						c->setPort("\\A", w);
						c->setPort("\\B", wr_bit);

						w = module->addWire(genid(cell->name, "$wren", i, "", j, "", wr_offset, "$y"));
						c->setPort("\\Y", RTLIL::SigSpec(w));
					}

					RTLIL::Cell *c = module->addCell(genid(cell->name, "$wrmux", i, "", j, "", wr_offset), "$mux");
					c->parameters["\\WIDTH"] = wr_width;
					c->setPort("\\A", sig.extract(wr_offset, wr_width));
					c->setPort("\\B", wr_data.extract(wr_offset, wr_width));
					c->setPort("\\S", RTLIL::SigSpec(w));

					w = module->addWire(genid(cell->name, "$wrmux", i, "", j, "", wr_offset, "$y"), wr_width);
					c->setPort("\\Y", w);

					sig.replace(wr_offset, w);
					wr_offset += wr_width;
					count_wrmux++;
				}
			}

			module->connect(RTLIL::SigSig(data_reg_in[i], sig));
		}

		log("  write interface: %d write mux blocks.\n", count_wrmux);

		module->remove(cell);
	}

	MemoryMapWorker(RTLIL::Design *design, RTLIL::Module *module) : design(design), module(module)
	{
		std::vector<RTLIL::Cell*> cells;
		for (auto cell : module->selected_cells())
			if (cell->type == "$mem" && design->selected(module, cell))
				cells.push_back(cell);
		for (auto cell : cells)
			handle_cell(cell);
	}
};

struct MemoryMapPass : public Pass {
	MemoryMapPass() : Pass("memory_map", "translate multiport memories to basic cells") { }
	void help() YS_OVERRIDE
	{
		//   |---v---|---v---|---v---|---v---|---v---|---v---|---v---|---v---|---v---|---v---|
		log("\n");
		log("    memory_map [selection]\n");
		log("\n");
		log("This pass converts multiport memory cells as generated by the memory_collect\n");
		log("pass to word-wide DFFs and address decoders.\n");
		log("\n");
	}
	void execute(std::vector<std::string> args, RTLIL::Design *design) YS_OVERRIDE {
		log_header(design, "Executing MEMORY_MAP pass (converting $mem cells to logic and flip-flops).\n");
		extra_args(args, 1, design);
		for (auto mod : design->selected_modules())
			MemoryMapWorker(design, mod);
	}
} MemoryMapPass;

PRIVATE_NAMESPACE_END
pan class="p">, File, Pos); File_Pos_To_Coord (File, Pos, Line_Pos, Line, Offset); end Location_To_Coord; function Location_File_To_Pos (Location : Location_Type; File : Source_File_Entry) return Source_Ptr is begin return Source_Ptr (Location - Source_Files.Table (File).First_Location); end Location_File_To_Pos; function Location_File_To_Line (Location : Location_Type; File : Source_File_Entry) return Positive is Line_Pos : Source_Ptr; Line : Positive; Offset : Natural; begin Location_To_Coord (Source_Files.Table (File), Location_File_To_Pos (Location, File), Line_Pos, Line, Offset); return Line; end Location_File_To_Line; function Location_File_Line_To_Col (Loc : Location_Type; File : Source_File_Entry; Line : Positive) return Natural is F : Source_File_Record renames Source_Files.Table (File); Line_Pos : constant Source_Ptr := F.Lines.Table (Line); Pos : constant Source_Ptr := Location_File_To_Pos (Loc, File); begin return Coord_To_Col (File, Line_Pos, Natural (Pos - Line_Pos)); end Location_File_Line_To_Col; function Location_File_Line_To_Offset (Loc : Location_Type; File : Source_File_Entry; Line : Positive) return Natural is F : Source_File_Record renames Source_Files.Table (File); Line_Pos : constant Source_Ptr := F.Lines.Table (Line); Pos : constant Source_Ptr := Location_File_To_Pos (Loc, File); begin return Natural (Pos - Line_Pos); end Location_File_Line_To_Offset; -- Convert the first digit of VAL into a character (base 10). function Digit_To_Char (Val: Natural) return Character is begin return Character'Val (Character'Pos ('0') + Val mod 10); end Digit_To_Char; function Get_Os_Time_Stamp return Time_Stamp_Id is use Ada.Calendar; use Ada.Calendar.Time_Zones; use Str_Table; Now : constant Time := Clock; Now_UTC : constant Time := Now - Duration (UTC_Time_Offset (Now) * 60); Year : Year_Number; Month : Month_Number; Day : Day_Number; Sec : Day_Duration; S : Integer; S1 : Integer; M : Integer; Res: Time_Stamp_Id; begin -- Use UTC time (like file time stamp). Split (Now_UTC, Year, Month, Day, Sec); Res := Time_Stamp_Id (Create_String8); Append_String8_Char (Digit_To_Char (Year / 1000)); Append_String8_Char (Digit_To_Char (Year / 100)); Append_String8_Char (Digit_To_Char (Year / 10)); Append_String8_Char (Digit_To_Char (Year / 1)); Append_String8_Char (Digit_To_Char (Month / 10)); Append_String8_Char (Digit_To_Char (Month / 1)); Append_String8_Char (Digit_To_Char (Day / 10)); Append_String8_Char (Digit_To_Char (Day / 1)); S := Integer (Sec); if Day_Duration (S) > Sec then -- We need a truncation. S := S - 1; end if; S1 := S / 3600; Append_String8_Char (Digit_To_Char (S1 / 10)); Append_String8_Char (Digit_To_Char (S1)); S1 := (S / 60) mod 60; Append_String8_Char (Digit_To_Char (S1 / 10)); Append_String8_Char (Digit_To_Char (S1)); S1 := S mod 60; Append_String8_Char (Digit_To_Char (S1 / 10)); Append_String8_Char (Digit_To_Char (S1)); Append_String8_Char ('.'); Sec := Sec - Day_Duration (S); M := Integer (Sec * 1000); if M = 1000 then -- We need truncation. M := 999; end if; Append_String8_Char (Digit_To_Char (M / 100)); Append_String8_Char (Digit_To_Char (M / 10)); Append_String8_Char (Digit_To_Char (M)); return Res; end Get_Os_Time_Stamp; function Get_Pathname (Directory : Name_Id; Name : Name_Id) return String is Filename : constant String := Image (Name); begin if not GNAT.OS_Lib.Is_Absolute_Path (Filename) then return Image (Directory) & Filename; else return Filename; end if; end Get_Pathname; procedure Normalize_Pathname (Directory : in out Name_Id; Name : in out Name_Id) is Filename : constant String := Image (Name); Separator_Pos : Natural; begin -- Find a directory part in NAME, return now if none. Separator_Pos := 0; for I in Filename'Range loop if Filename (I) = '/' or Filename (I) = '\' then Separator_Pos := I; end if; end loop; if Separator_Pos = 0 then return; end if; -- Move the directory part to DIRECTORY. declare File_Dir : constant String := Filename (Filename'First .. Separator_Pos); begin if Directory /= Null_Identifier then Directory := Get_Identifier (Image (Directory) & File_Dir); else Directory := Get_Identifier (File_Dir); end if; end; Name := Get_Identifier (Filename (Separator_Pos + 1 .. Filename'Last)); end Normalize_Pathname; -- Find a source_file by DIRECTORY and NAME. -- Return NO_SOURCE_FILE_ENTRY if not already opened. function Find_Source_File (Directory : Name_Id; Name: Name_Id) return Source_File_Entry is begin for I in Source_Files.First .. Source_Files.Last loop if Source_Files.Table (I).File_Name = Name and then Source_Files.Table (I).Directory = Directory then return I; end if; end loop; return No_Source_File_Entry; end Find_Source_File; -- Return an entry for a filename. -- The file is not loaded. function Create_Source_File_Entry (Directory : Name_Id; Name: Name_Id) return Source_File_Entry is Res: Source_File_Entry; begin -- File must not already exist. pragma Assert (Find_Source_File (Directory, Name) = No_Source_File_Entry); -- Create a new entry. Res := Source_Files.Allocate; Source_Files.Table (Res) := (Kind => Source_File_File, First_Location => Next_Location, Last_Location => Next_Location, File_Name => Name, Directory => Directory, Checksum => No_File_Checksum_Id, Source => null, File_Length => 0, Lines => <>, Cache_Pos => Source_Ptr_Org, Cache_Line => 1, Gap_Start => Source_Ptr_Last, Gap_Last => Source_Ptr_Last); Lines_Tables.Init (Source_Files.Table (Res).Lines, Lines_Table_Init); File_Add_Line_Number (Res, 1, Source_Ptr_Org); return Res; end Create_Source_File_Entry; function Create_Source_File_From_String (Name: Name_Id; Content : String) return Source_File_Entry is Len : constant Source_Ptr := Source_Ptr (Content'Length); Res : Source_File_Entry; Buffer: File_Buffer_Acc; begin -- Fill buffer. Buffer := new File_Buffer (Source_Ptr_Org .. Source_Ptr_Org + Len + 1); if Len /= 0 then Buffer (Source_Ptr_Org .. Source_Ptr_Org + Len - 1) := File_Buffer (Content); end if; -- Create entry. Res := Source_Files.Allocate; Source_Files.Table (Res) := (Kind => Source_File_String, First_Location => Next_Location, Last_Location => Next_Location + Location_Type (Len) + 1, File_Name => Name, Directory => Null_Identifier, Checksum => No_File_Checksum_Id, Source => Buffer, File_Length => 0); Set_File_Length (Res, Len); Next_Location := Source_Files.Table (Res).Last_Location + 1; return Res; end Create_Source_File_From_String; function Create_Virtual_Source_File (Name: Name_Id) return Source_File_Entry is begin return Create_Source_File_From_String (Name, ""); end Create_Virtual_Source_File; function Create_Instance_Source_File (Ref : Source_File_Entry; Loc : Location_Type; Inst : Vhdl.Types.Vhdl_Node) return Source_File_Entry is pragma Unreferenced (Inst); Base : Source_File_Entry; Res : Source_File_Entry; begin if Source_Files.Table (Ref).Kind = Source_File_Instance then Base := Source_Files.Table (Ref).Base; else Base := Ref; end if; -- Create entry. Res := Source_Files.Allocate; declare F : Source_File_Record renames Source_Files.Table (Base); begin Source_Files.Table (Res) := (Kind => Source_File_Instance, First_Location => Next_Location, Last_Location => Next_Location + Location_Type (F.File_Length) + 1, File_Name => F.File_Name, Directory => F.Directory, Checksum => F.Checksum, Source => F.Source, File_Length => F.File_Length, Ref => Ref, Base => Base, Instance_Loc => Loc); Next_Location := Source_Files.Table (Res).Last_Location + 1; end; return Res; end Create_Instance_Source_File; function Instance_Relocate (Inst_File : Source_File_Entry; Loc : Location_Type) return Location_Type is pragma Assert (Inst_File <= Source_Files.Last); F : Source_File_Record renames Source_Files.Table (Inst_File); pragma Assert (F.Kind = Source_File_Instance); R : Source_File_Record renames Source_Files.Table (F.Ref); begin if Loc >= R.First_Location and Loc <= R.Last_Location then return F.First_Location + (Loc - R.First_Location); else return Loc; end if; end Instance_Relocate; function Location_Instance_To_Location (Loc : Location_Type) return Location_Type is File : Source_File_Entry; Pos : Source_Ptr; begin if Loc = No_Location then return No_Location; end if; Location_To_File_Pos (Loc, File, Pos); if Source_Files.Table (File).Kind = Source_File_Instance then return Source_Files.Table (File).Instance_Loc; else return No_Location; end if; end Location_Instance_To_Location; function Reserve_Source_File (Directory : Name_Id; Name: Name_Id; Length : Source_Ptr) return Source_File_Entry is pragma Assert (Length >= 2); Res : Source_File_Entry; begin Res := Create_Source_File_Entry (Directory, Name); declare F : Source_File_Record renames Source_Files.Table (Res); begin F.Source := new File_Buffer (Source_Ptr_Org .. Source_Ptr_Org + Length - 1); -- Read_Source_File call must follow its Create_Source_File. pragma Assert (F.First_Location = Next_Location); F.Last_Location := Next_Location + Location_Type (Length) - 1; Next_Location := F.Last_Location + 1; end; return Res; end Reserve_Source_File; -- Return an entry for a filename. -- Load the filename if necessary. function Read_Source_File (Directory : Name_Id; Name: Name_Id) return Source_File_Entry is use GNAT.OS_Lib; Fd : File_Descriptor; Res : Source_File_Entry; Raw_Length : Long_Integer; Length : Source_Ptr; Buffer : File_Buffer_Acc; begin -- The file is not supposed to be already loaded, but this could happen -- if the same file is compiled in two libraries. Res := Find_Source_File (Directory, Name); if Res /= No_Source_File_Entry then return Res; end if; -- Open the file (punt on non regular files). declare Filename : constant String := Get_Pathname (Directory, Name); Filename0 : constant String := Filename & ASCII.NUL; begin if not Is_Regular_File (Filename) then return No_Source_File_Entry; end if; Fd := Open_Read (Filename0'Address, Binary); if Fd = Invalid_FD then return No_Source_File_Entry; end if; end; Raw_Length := File_Length (Fd); -- Check for too large files. Use 'Pos (ie universal integer) to avoid -- errors in conversions. if Long_Integer'Pos (Raw_Length) > Source_Ptr'Pos (Source_Ptr'Last) or else Long_Integer'Pos (Raw_Length) > Integer'Pos (Integer'Last) then Close (Fd); return No_Source_File_Entry; end if; Length := Source_Ptr (Raw_Length); Res := Reserve_Source_File (Directory, Name, Length + 2); if Res = No_Source_File_Entry then Close (Fd); return No_Source_File_Entry; end if; Buffer := Get_File_Source (Res); if Read (Fd, Buffer (Source_Ptr_Org)'Address, Integer (Length)) /= Integer (Length) then Close (Fd); raise Internal_Error; end if; Close (Fd); Set_File_Length (Res, Length); -- Set the gap. Source_Files.Table (Res).Gap_Start := Source_Ptr_Org + Length + 2; Source_Files.Table (Res).Gap_Last := Source_Files.Table (Res).Source'Last; -- Compute the SHA1. declare use GNAT.SHA1; use Str_Table; subtype Buffer_String is String (1 .. Buffer'Length - 2); Buffer_Digest : Message_Digest; begin if Length /= 0 then -- Avoid weird bounds for empty buffers. Buffer_Digest := Digest (Buffer_String (Buffer (Source_Ptr_Org .. Source_Ptr_Org + Length - 1))); end if; Source_Files.Table (Res).Checksum := File_Checksum_Id (Create_String8); for I in Buffer_Digest'Range loop Append_String8_Char (Buffer_Digest (I)); end loop; end; return Res; end Read_Source_File; procedure Discard_Source_File (File : Source_File_Entry) is pragma Assert (File <= Source_Files.Last); F : Source_File_Record renames Source_Files.Table (File); begin F.File_Name := Null_Identifier; F.Directory := Null_Identifier; end Discard_Source_File; procedure Free_Source_File (File : Source_File_Entry) is procedure Free is new Ada.Unchecked_Deallocation (File_Buffer, File_Buffer_Acc); F : Source_File_Record renames Source_Files.Table (File); begin case F.Kind is when Source_File_File => Lines_Tables.Free (F.Lines); Free (F.Source); when Source_File_String => Free (F.Source); when Source_File_Instance => null; end case; end Free_Source_File; procedure Unload_Last_Source_File (File : Source_File_Entry) is begin pragma Assert (File = Source_Files.Last); Free_Source_File (File); Source_Files.Decrement_Last; Next_Location := Source_Files.Table (Source_Files.Last).Last_Location + 1; end Unload_Last_Source_File; procedure Skip_Gap (File : Source_File_Entry; Pos : in out Source_Ptr) is pragma Assert (File <= Source_Files.Last); F : Source_File_Record renames Source_Files.Table (File); begin if Pos = F.Gap_Start then Pos := F.Gap_Last + 1; end if; end Skip_Gap; -- Check validity of FILE. -- Raise an exception in case of error. procedure Check_File (File : Source_File_Entry) is begin pragma Assert (File <= Source_Files.Last); null; end Check_File; -- Return a buffer (access to the contents of the file) for a file entry. function Get_File_Source (File: Source_File_Entry) return File_Buffer_Acc is begin Check_File (File); return Source_Files.Table (File).Source; end Get_File_Source; function Get_File_Buffer (File : Source_File_Entry) return File_Buffer_Ptr is begin return To_File_Buffer_Ptr (Source_Files.Table (File).Source (Source_Ptr_Org)'Address); end Get_File_Buffer; procedure Set_File_Length (File : Source_File_Entry; Length : Source_Ptr) is begin Check_File (File); declare F : Source_File_Record renames Source_Files.Table (File); Buffer : File_Buffer_Acc renames F.Source; begin pragma Assert (Length <= Buffer'Length - 2); F.File_Length := Length; Buffer (Source_Ptr_Org + Length) := EOT; Buffer (Source_Ptr_Org + Length + 1) := EOT; end; end Set_File_Length; function Get_File_Length (File: Source_File_Entry) return Source_Ptr is begin Check_File (File); return Source_Files.Table (File).File_Length; end Get_File_Length; function Get_Content_Length (File : Source_File_Entry) return Source_Ptr is pragma Assert (File <= Source_Files.Last); F : Source_File_Record renames Source_Files.Table (File); begin if F.Gap_Start >= F.File_Length then return F.File_Length; else return F.File_Length - (F.Gap_Last - F.Gap_Start + 1); end if; end Get_Content_Length; function Get_Buffer_Length (File : Source_File_Entry) return Source_Ptr is pragma Assert (File <= Source_Files.Last); F : Source_File_Record renames Source_Files.Table (File); begin return Source_Ptr (F.Last_Location - F.First_Location + 1); end Get_Buffer_Length; -- Return the name of the file. function Get_File_Name (File: Source_File_Entry) return Name_Id is begin Check_File (File); return Source_Files.Table (File).File_Name; end Get_File_Name; function Get_File_Checksum (File : Source_File_Entry) return File_Checksum_Id is begin Check_File (File); return Source_Files.Table (File).Checksum; end Get_File_Checksum; function Get_Directory_Name (File : Source_File_Entry) return Name_Id is begin Check_File (File); return Source_Files.Table (File).Directory; end Get_Directory_Name; function File_Line_To_Position (File : Source_File_Entry; Line : Positive) return Source_Ptr is pragma Assert (File <= Source_Files.Last); Source_File: Source_File_Record renames Source_Files.Table (File); begin case Source_File.Kind is when Source_File_File => if Line > Lines_Tables.Last (Source_File.Lines) then return Source_Ptr_Bad; else return Source_File.Lines.Table (Line); end if; when Source_File_String => if Line /= 1 then return Source_Ptr_Bad; else return Source_Ptr_Org; end if; when Source_File_Instance => return File_Line_To_Position (Source_File.Base, Line); end case; end File_Line_To_Position; function Is_Eq (L : Time_Stamp_Id; R : Time_Stamp_Id) return Boolean is use Str_Table; L_Str : constant String8_Id := String8_Id (L); R_Str : constant String8_Id := String8_Id (R); begin for I in 1 .. Nat32 (Time_Stamp_String'Length) loop if Element_String8 (L_Str, I) /= Element_String8 (R_Str, I) then return False; end if; end loop; return True; end Is_Eq; function Is_Eq (L, R : File_Checksum_Id) return Boolean is use Str_Table; L_Str : constant String8_Id := String8_Id (L); R_Str : constant String8_Id := String8_Id (R); begin for I in 1 .. Nat32 (File_Checksum_String'Length) loop if Element_String8 (L_Str, I) /= Element_String8 (R_Str, I) then return False; end if; end loop; return True; end Is_Eq; function Is_Gt (L : Time_Stamp_Id; R : Time_Stamp_Id) return Boolean is use Str_Table; L_Str : constant String8_Id := String8_Id (L); R_Str : constant String8_Id := String8_Id (R); E_L, E_R : Nat8; begin for I in 1 .. Nat32 (Time_Stamp_String'Length) loop E_L := Element_String8 (L_Str, I); E_R := Element_String8 (R_Str, I); if E_L /= E_R then return E_L > E_R; end if; end loop; return False; end Is_Gt; function Get_Time_Stamp_String (Ts : Time_Stamp_Id) return String is begin if Ts = Null_Time_Stamp then return "NULL_TS"; else return Str_Table.String_String8 (String8_Id (Ts), Time_Stamp_String'Length); end if; end Get_Time_Stamp_String; function Get_File_Checksum_String (Checksum : File_Checksum_Id) return String is begin if Checksum = No_File_Checksum_Id then return "NO_CHECKSUM"; else return Str_Table.String_String8 (String8_Id (Checksum), File_Checksum_String'Length); end if; end Get_File_Checksum_String; function Image (Loc : Location_Type; Filename : Boolean := True) return string is Line, Col : Natural; Name : Name_Id; begin if Loc = Location_Nil then -- Avoid a crash. return "??:??:??"; end if; Location_To_Position (Loc, Name, Line, Col); declare Line_Str : constant String := Natural'Image (Line); Col_Str : constant String := Natural'Image (Col); begin if Filename then return Name_Table.Image (Name) & ':' & Line_Str (Line_Str'First + 1 .. Line_Str'Last) & ':' & Col_Str (Col_Str'First + 1 .. Col_Str'Last); else return Line_Str (Line_Str'First + 1 .. Line_Str'Last) & ':' & Col_Str (Col_Str'First + 1 .. Col_Str'Last); end if; end; end Image; -- Compute the length of line that starts at START. Tabs are expanded to -- compute the length. function Compute_Expanded_Line_Length (File : Source_File_Entry; Start : Source_Ptr) return Natural is Buf : constant File_Buffer_Acc := Get_File_Source (File); Pos : Source_Ptr; Len : Natural; C : Character; begin -- Compute line length. Pos := Start; Len := 0; loop C := Buf (Pos); Pos := Pos + 1; exit when C = ASCII.CR or C = ASCII.LF or C = ASCII.EOT; if C = ASCII.HT then -- Expand tab. Len := Len + (Tab_Stop - Len mod Tab_Stop); else Len := Len + 1; end if; end loop; return Len; end Compute_Expanded_Line_Length; -- Return the line that starts at START in FILE. This is slow. function Extract_Expanded_Line (File : Source_File_Entry; Start : Source_Ptr) return String is Buf : constant File_Buffer_Acc := Get_File_Source (File); Len : constant Natural := Compute_Expanded_Line_Length (File, Start); Res : String (1 .. Len); P : Natural; Pos : Source_Ptr; C : Character; begin Pos := Start; P := 0; loop C := Buf (Pos); Pos := Pos + 1; exit when C = ASCII.CR or C = ASCII.LF or C = ASCII.EOT; if C = ASCII.HT then -- Expand tab. loop P := P + 1; Res (P) := ' '; exit when P mod Tab_Stop = 0; end loop; else P := P + 1; Res (P) := C; end if; end loop; pragma Assert (P = Res'Last); return Res; end Extract_Expanded_Line; function Extract_Expanded_Line (File : Source_File_Entry; Line : Positive) return String is Start : constant Source_Ptr := File_Line_To_Position (File, Line); begin return Extract_Expanded_Line (File, Start); end Extract_Expanded_Line; -- Debug procedures. procedure Debug_Source_Loc (Loc : Location_Type) is File : Source_File_Entry; Line_Pos : Source_Ptr; Line : Natural; Offset : Natural; begin Location_To_Coord (Loc, File, Line_Pos, Line, Offset); Log_Line (Extract_Expanded_Line (File, Line_Pos)); end Debug_Source_Loc; -- Disp sources lines of a file. procedure Debug_Source_Lines (File: Source_File_Entry) is Source_File: Source_File_Record renames Source_Files.Table (File); begin Check_File (File); for I in Lines_Tables.First .. Lines_Tables.Last (Source_File.Lines) loop Log_Line ("line" & Natural'Image (I) & " at offset" & Source_Ptr'Image (Source_File.Lines.Table (I))); end loop; end Debug_Source_Lines; procedure Debug_Source_File (File : Source_File_Entry) is F : Source_File_Record renames Source_Files.Table(File); begin Log ("*"); Log (Source_File_Entry'Image (File)); Log (" name: " & Image (F.File_Name)); Log (" dir:" & Image (F.Directory)); Log (" file length:" & Source_Ptr'Image (F.File_Length)); Log_Line; Log (" location:" & Location_Type'Image (F.First_Location) & " -" & Location_Type'Image (F.Last_Location)); Log_Line; if F.Checksum /= No_File_Checksum_Id then Log (" checksum: " & Get_File_Checksum_String (F.Checksum)); Log_Line; end if; case F.Kind is when Source_File_File => if F.Source = null then Log (" no buf"); else Log (" buf:" & Source_Ptr'Image (F.Source'First) & " -" & Source_Ptr'Image (F.Source'Last)); end if; Log_Line; Log (" nbr lines:" & Natural'Image (Lines_Tables.Last (F.Lines))); Log_Line; Log (" Gap:" & Source_Ptr'Image (F.Gap_Start) & " -" & Source_Ptr'Image (F.Gap_Last)); Log_Line; when Source_File_String => null; when Source_File_Instance => Log (" instance from:" & Source_File_Entry'Image (F.Ref)); Log (", base:" & Source_File_Entry'Image (F.Base)); Log (", loc:" & Image (F.Instance_Loc)); Log_Line; end case; end Debug_Source_File; procedure Debug_Source_Files is begin for I in Source_Files.First .. Source_Files.Last loop Debug_Source_File (I); end loop; end Debug_Source_Files; pragma Unreferenced (Debug_Source_Lines); pragma Unreferenced (Debug_Source_Loc); procedure Initialize is begin for I in Source_Files.First .. Source_Files.Last loop Free_Source_File (I); end loop; Source_Files.Free; Source_Files.Init; Next_Location := Location_Nil + 1; end Initialize; end Files_Map;