aboutsummaryrefslogtreecommitdiffstats
path: root/techlibs/xilinx/tests/test_dsp48a1_model.v
blob: 66346b47bfa861be3c5941b31b288840c30f404d (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
`timescale 1ns / 1ps

module testbench;
	parameter integer A0REG = 1;
	parameter integer A1REG = 1;
	parameter integer B0REG = 1;
	parameter integer B1REG = 1;
	parameter integer CREG = 1;
	parameter integer DREG = 1;
	parameter integer MREG = 1;
	parameter integer PREG = 1;
	parameter integer CARRYINREG = 1;
	parameter integer CARRYOUTREG = 1;
	parameter integer OPMODEREG = 1;
	parameter CARRYINSEL = "OPMODE5";
	parameter RSTTYPE = "SYNC";

	reg CLK;
	reg CEA, CEB, CEC, CED, CEM, CEP, CECARRYIN, CEOPMODE;
	reg RSTA, RSTB, RSTC, RSTD, RSTM, RSTP, RSTCARRYIN, RSTOPMODE;
	reg [17:0] A;
	reg [17:0] B;
	reg [47:0] C;
	reg [17:0] D;
	reg [47:0] PCIN;
	reg [7:0] OPMODE;
	reg CARRYIN;

	output CARRYOUTF, REF_CARRYOUTF;
	output CARRYOUT, REF_CARRYOUT, REF_OLD_CARRYOUT;
	output [35:0] M, REF_M;
	output [47:0] P, REF_P, REF_OLD_P;
	output [17:0] BCOUT, REF_BCOUT, REF_OLD_BCOUT;
	output [47:0] PCOUT, REF_PCOUT, REF_OLD_PCOUT;

	integer errcount = 0;

	reg ERROR_FLAG = 0;

	task clkcycle;
		begin
			#5;
			CLK = ~CLK;
			#10;
			CLK = ~CLK;
			#2;
			ERROR_FLAG = 0;
			if (REF_BCOUT !== BCOUT || REF_OLD_BCOUT != BCOUT) begin
				$display("ERROR at %1t: REF_BCOUT=%b REF_OLD_BCOUT=%b UUT_BCOUT=%b DIFF=%b", $time, REF_BCOUT, REF_OLD_BCOUT, BCOUT, REF_BCOUT ^ BCOUT);
				errcount = errcount + 1;
				ERROR_FLAG = 1;
			end
			if (REF_M !== M) begin
				$display("ERROR at %1t: REF_M=%b UUT_M=%b DIFF=%b", $time, REF_M, M, REF_M ^ M);
				errcount = errcount + 1;
				ERROR_FLAG = 1;
			end
			if (REF_P !== P || REF_OLD_P != P) begin
				$display("ERROR at %1t: REF_P=%b REF_OLD_P=%b UUT_P=%b DIFF=%b", $time, REF_P, REF_OLD_P, P, REF_P ^ P);
				errcount = errcount + 1;
				ERROR_FLAG = 1;
			end
			if (REF_PCOUT !== PCOUT || REF_OLD_PCOUT != PCOUT) begin
				$display("ERROR at %1t: REF_PCOUT=%b REF_OLD_PCOUT=%b UUT_PCOUT=%b DIFF=%b", $time, REF_PCOUT, REF_OLD_PCOUT, PCOUT, REF_PCOUT ^ PCOUT);
				errcount = errcount + 1;
				ERROR_FLAG = 1;
			end
			if (REF_CARRYOUT !== CARRYOUT || (REF_OLD_CARRYOUT != CARRYOUT && !CARRYOUTREG)) begin
				$display("ERROR at %1t: REF_CARRYOUT=%b REF_OLD_CARRYOUT=%b UUT_CARRYOUT=%b DIFF=%b", $time, REF_CARRYOUT, REF_OLD_CARRYOUT, CARRYOUT, REF_CARRYOUT ^ CARRYOUT);
				errcount = errcount + 1;
				ERROR_FLAG = 1;
			end
			if (REF_CARRYOUTF !== CARRYOUTF) begin
				$display("ERROR at %1t: REF_CARRYOUTF=%b UUT_CARRYOUTF=%b", $time, REF_CARRYOUTF, CARRYOUTF);
				errcount = errcount + 1;
				ERROR_FLAG = 1;
			end
			#3;
		end
	endtask

	reg config_valid = 0;
	task drc;
		begin
			config_valid = 1;

			if (OPMODE[1:0] == 2'b10 && PREG != 1) config_valid = 0;
			if (OPMODE[3:2] == 2'b10 && PREG != 1) config_valid = 0;
		end
	endtask

	initial begin
		$dumpfile("test_dsp48a1_model.vcd");
		$dumpvars(0, testbench);

		#2;
		CLK = 1'b0;
		{CEA, CEB, CEC, CED, CEM, CEP, CECARRYIN, CEOPMODE} = 8'b11111111;
		{A, B, C, D, PCIN, OPMODE, CARRYIN} = 0;
		{RSTA, RSTB, RSTC, RSTD, RSTM, RSTP, RSTCARRYIN, RSTOPMODE} = 8'b11111111;
		repeat (10) begin
			#10;
			CLK = 1'b1;
			#10;
			CLK = 1'b0;
			#10;
			CLK = 1'b1;
			#10;
			CLK = 1'b0;
		end
		{RSTA, RSTB, RSTC, RSTD, RSTM, RSTP, RSTCARRYIN, RSTOPMODE} = 0;

		repeat (10000) begin
			clkcycle;
			config_valid = 0;
			while (!config_valid) begin
				A = $urandom;
				B = $urandom;
				C = {$urandom, $urandom};
				D = $urandom;
				PCIN = {$urandom, $urandom};

				{CEA, CEB, CEC, CED, CEM, CEP, CECARRYIN, CEOPMODE} = $urandom | $urandom | $urandom;
				{RSTA, RSTB, RSTC, RSTD, RSTM, RSTP, RSTCARRYIN, RSTOPMODE} = $urandom & $urandom & $urandom & $urandom & $urandom & $urandom;
				{CARRYIN, OPMODE} = $urandom;

				drc;
			end
		end

		if (errcount == 0) begin
			$display("All tests passed.");
			$finish;
		end else begin
			$display("Caught %1d errors.", errcount);
			$stop;
		end
	end

	DSP48A #(
		.A0REG              (A0REG),
		.A1REG              (A1REG),
		.B0REG              (B0REG),
		.B1REG              (B1REG),
		.CREG               (CREG),
		.DREG               (DREG),
		.MREG               (MREG),
		.PREG               (PREG),
		.CARRYINREG         (CARRYINREG),
		.OPMODEREG          (OPMODEREG),
		.CARRYINSEL         (CARRYINSEL),
		.RSTTYPE            (RSTTYPE)
	) ref_old (
		.A             (A),
		.B             (B),
		.C             (C),
		.D             (D),
		.PCIN          (PCIN),
		.CARRYIN       (CARRYIN),
		.OPMODE        (OPMODE),
		.BCOUT         (REF_OLD_BCOUT),
		.CARRYOUT      (REF_OLD_CARRYOUT),
		.P             (REF_OLD_P),
		.PCOUT         (REF_OLD_PCOUT),
		.CEA           (CEA),
		.CEB           (CEB),
		.CEC           (CEC),
		.CED           (CED),
		.CEM           (CEM),
		.CEP           (CEP),
		.CECARRYIN     (CECARRYIN),
		.CEOPMODE      (CEOPMODE),
		.CLK           (CLK),
		.RSTA          (RSTA),
		.RSTB          (RSTB),
		.RSTC          (RSTC),
		.RSTD          (RSTD),
		.RSTM          (RSTM),
		.RSTP          (RSTP),
		.RSTCARRYIN    (RSTCARRYIN),
		.RSTOPMODE     (RSTOPMODE)
	);

	DSP48A1 #(
		.A0REG              (A0REG),
		.A1REG              (A1REG),
		.B0REG              (B0REG),
		.B1REG              (B1REG),
		.CREG               (CREG),
		.DREG               (DREG),
		.MREG               (MREG),
		.PREG               (PREG),
		.CARRYINREG         (CARRYINREG),
		.CARRYOUTREG        (CARRYOUTREG),
		.OPMODEREG          (OPMODEREG),
		.CARRYINSEL         (CARRYINSEL),
		.RSTTYPE            (RSTTYPE)
	) ref (
		.A             (A),
		.B             (B),
		.C             (C),
		.D             (D),
		.PCIN          (PCIN),
		.CARRYIN       (CARRYIN),
		.OPMODE        (OPMODE),
		.BCOUT         (REF_BCOUT),
		.CARRYOUTF     (REF_CARRYOUTF),
		.CARRYOUT      (REF_CARRYOUT),
		.P             (REF_P),
		.M             (REF_M),
		.PCOUT         (REF_PCOUT),
		.CEA           (CEA),
		.CEB           (CEB),
		.CEC           (CEC),
		.CED           (CED),
		.CEM           (CEM),
		.CEP           (CEP),
		.CECARRYIN     (CECARRYIN),
		.CEOPMODE      (CEOPMODE),
		.CLK           (CLK),
		.RSTA          (RSTA),
		.RSTB          (RSTB),
		.RSTC          (RSTC),
		.RSTD          (RSTD),
		.RSTM          (RSTM),
		.RSTP          (RSTP),
		.RSTCARRYIN    (RSTCARRYIN),
		.RSTOPMODE     (RSTOPMODE)
	);

	DSP48A1_UUT #(
		.A0REG              (A0REG),
		.A1REG              (A1REG),
		.B0REG              (B0REG),
		.B1REG              (B1REG),
		.CREG               (CREG),
		.DREG               (DREG),
		.MREG               (MREG),
		.PREG               (PREG),
		.CARRYINREG         (CARRYINREG),
		.CARRYOUTREG        (CARRYOUTREG),
		.OPMODEREG          (OPMODEREG),
		.CARRYINSEL         (CARRYINSEL),
		.RSTTYPE            (RSTTYPE)
	) uut (
		.A             (A),
		.B             (B),
		.C             (C),
		.D             (D),
		.PCIN          (PCIN),
		.CARRYIN       (CARRYIN),
		.OPMODE        (OPMODE),
		.BCOUT         (BCOUT),
		.CARRYOUTF     (CARRYOUTF),
		.CARRYOUT      (CARRYOUT),
		.P             (P),
		.M             (M),
		.PCOUT         (PCOUT),
		.CEA           (CEA),
		.CEB           (CEB),
		.CEC           (CEC),
		.CED           (CED),
		.CEM           (CEM),
		.CEP           (CEP),
		.CECARRYIN     (CECARRYIN),
		.CEOPMODE      (CEOPMODE),
		.CLK           (CLK),
		.RSTA          (RSTA),
		.RSTB          (RSTB),
		.RSTC          (RSTC),
		.RSTD          (RSTD),
		.RSTM          (RSTM),
		.RSTP          (RSTP),
		.RSTCARRYIN    (RSTCARRYIN),
		.RSTOPMODE     (RSTOPMODE)
	);
endmodule

module mult_noreg;
	testbench #(
		.A0REG              (0),
		.A1REG              (0),
		.B0REG              (0),
		.B1REG              (0),
		.CREG               (0),
		.DREG               (0),
		.MREG               (0),
		.PREG               (0),
		.CARRYINREG         (0),
		.CARRYOUTREG        (0),
		.OPMODEREG          (0),
		.CARRYINSEL         ("CARRYIN"),
		.RSTTYPE            ("SYNC")
	) testbench ();
endmodule

module mult_allreg;
	testbench #(
		.A0REG              (1),
		.A1REG              (1),
		.B0REG              (1),
		.B1REG              (1),
		.CREG               (1),
		.DREG               (1),
		.MREG               (1),
		.PREG               (1),
		.CARRYINREG         (1),
		.CARRYOUTREG        (1),
		.OPMODEREG          (1),
		.CARRYINSEL         ("OPMODE5"),
		.RSTTYPE            ("SYNC")
	) testbench ();
endmodule

module mult_inreg;
	testbench #(
		.A0REG              (1),
		.A1REG              (1),
		.B0REG              (1),
		.B1REG              (1),
		.CREG               (1),
		.DREG               (1),
		.MREG               (0),
		.PREG               (0),
		.CARRYINREG         (1),
		.CARRYOUTREG        (0),
		.OPMODEREG          (0),
		.CARRYINSEL         ("CARRYIN"),
		.RSTTYPE            ("SYNC")
	) testbench ();
endmodule
class="n">V.Flag_Token); return V.Value; end Read_Value; procedure Append_Token (Ctxt : in out Format_Ctxt; Tok : Etoken_Type; Col : Natural) is Etok : Etoken_Record; begin Etok := (Flag_Token => True, Tok => Tok, Col => Col, others => False); Token_Table.Append (Ctxt.Toks, To_Uns32 (Etok)); end Append_Token; procedure Append_Token (Ctxt : in out Format_Ctxt; Tok : Token_Type) is begin Append_Token (Ctxt, Token_Type'Pos (Tok), Get_Token_Offset + 1); end Append_Token; procedure Append_Value (Ctxt : in out Format_Ctxt; Val : Nat32) is V : Evalue_Record; begin V := (Flag_Token => False, Value => Val); Token_Table.Append (Ctxt.Toks, To_Uns32 (V)); end Append_Value; procedure Append_Source_Token (Ctxt : in out Format_Ctxt; Tok : Token_Type) is begin Append_Token (Ctxt, Token_Type'Pos (Tok), Get_Token_Offset + 1); Append_Value (Ctxt, Get_Token_Length); Append_Value (Ctxt, Nat32 (Get_Token_Position)); end Append_Source_Token; procedure Append_Eof (Ctxt : in out Format_Ctxt) is begin Append_Token (Ctxt, Token_Type'Pos (Tok_Eof), 0); end Append_Eof; procedure Init (Ctxt : out Format_Ctxt; Sfe : Source_File_Entry; First_Line : Positive := 1; Last_Line : Positive := Positive'Last) is begin Ctxt := (First_Line => First_Line, Last_Line => Last_Line, Lineno => 1, Enable => First_Line = 1, Flag_Lit => False, Vnum => 0, Hnum => 0, Hfirst => True, Sfe => Sfe, Toks => <>); Token_Table.Init (Ctxt.Toks, 1024); if First_Line = 1 then Append_Token (Ctxt, Etok_No_Indent, 0); end if; end Init; procedure Free (Ctxt : in out Format_Ctxt) is begin Token_Table.Free (Ctxt.Toks); end Free; function Get_Source_File_Entry (Ctxt : Format_Ctxt) return Source_File_Entry is begin return Ctxt.Sfe; end Get_Source_File_Entry; procedure Skip_Newline (Ctxt : in out Format_Ctxt) is begin Ctxt.Lineno := Ctxt.Lineno + 1; if Ctxt.Enable then Append_Token (Ctxt, Token_Type'Pos (Tok_Newline), 0); if Ctxt.Last_Line < Ctxt.Lineno then Ctxt.Enable := False; end if; else if Ctxt.First_Line = Ctxt.Lineno then Ctxt.Enable := True; Append_Token (Ctxt, Etok_Set_Vbox, Ctxt.Vnum); if Ctxt.Hfirst then Append_Token (Ctxt, Etok_No_Indent, 0); end if; end if; end if; end Skip_Newline; procedure Skip_Spaces (Ctxt : in out Format_Ctxt) is begin loop case Current_Token is when Tok_Eof => raise Internal_Error; when Tok_Newline => Skip_Newline (Ctxt); Scan; when Tok_Line_Comment => if Ctxt.Enable then Append_Source_Token (Ctxt, Current_Token); end if; Scan; when Tok_Block_Comment_Start => if Ctxt.Enable then Append_Token (Ctxt, Tok_Block_Comment_Start); end if; loop Scan_Block_Comment; case Current_Token is when Tok_Eof => exit; when Tok_Block_Comment_Text => if Ctxt.Enable then Append_Source_Token (Ctxt, Current_Token); end if; when Tok_Block_Comment_End => if Ctxt.Enable then Append_Token (Ctxt, Tok_Block_Comment_End); end if; exit; when Tok_Newline => Skip_Newline (Ctxt); when others => raise Internal_Error; end case; end loop; Scan; when others => exit; end case; end loop; end Skip_Spaces; procedure Valign (Ctxt : in out Format_Ctxt; Point : Valign_Type) is begin if Ctxt.Enable then Append_Token (Ctxt, Etok_Valign, Valign_Type'Pos (Point)); end if; end Valign; procedure Start_Hbox (Ctxt : in out Format_Ctxt) is begin Ctxt.Hnum := Ctxt.Hnum + 1; if Ctxt.Hnum = 1 then Ctxt.Hfirst := True; end if; end Start_Hbox; procedure Close_Hbox (Ctxt : in out Format_Ctxt) is begin if Ctxt.Enable and Ctxt.Hnum = 1 then Append_Token (Ctxt, Etok_No_Indent, 0); end if; Ctxt.Hnum := Ctxt.Hnum - 1; end Close_Hbox; procedure Start_Vbox (Ctxt : in out Format_Ctxt) is begin pragma Assert (Ctxt.Hnum = 0); Ctxt.Vnum := Ctxt.Vnum + 1; if Ctxt.Enable then Append_Token (Ctxt, Etok_Start_Vbox, Ctxt.Vnum); end if; end Start_Vbox; procedure Close_Vbox (Ctxt : in out Format_Ctxt) is begin Skip_Spaces (Ctxt); Ctxt.Vnum := Ctxt.Vnum - 1; if Ctxt.Enable then Append_Token (Ctxt, Etok_Close_Vbox, Ctxt.Vnum); end if; end Close_Vbox; procedure Disp_Token (Ctxt : in out Format_Ctxt; Tok : Token_Type) is begin Skip_Spaces (Ctxt); if Ctxt.Enable then Append_Token (Ctxt, Tok); end if; Ctxt.Hfirst := False; Check_Token (Tok); Scan; end Disp_Token; procedure Start_Lit (Ctxt : in out Format_Ctxt; Tok : Token_Type) is begin pragma Assert (not Ctxt.Flag_Lit); Ctxt.Flag_Lit := True; Skip_Spaces (Ctxt); -- For bit string with length (vhdl08), first store the length. if Tok = Tok_Bit_String and then Current_Token = Tok_Integer_Letter then if Ctxt.Enable then Append_Source_Token (Ctxt, Tok_Integer_Letter); end if; Scan; end if; if Ctxt.Enable then Append_Source_Token (Ctxt, Tok); end if; Ctxt.Hfirst := False; Check_Token (Tok); Scan; end Start_Lit; procedure Disp_Char (Ctxt : in out Format_Ctxt; C : Character) is pragma Unreferenced (C); begin pragma Assert (Ctxt.Flag_Lit); null; end Disp_Char; procedure Close_Lit (Ctxt : in out Format_Ctxt) is begin pragma Assert (Ctxt.Flag_Lit); Ctxt.Flag_Lit := False; end Close_Lit; end Format_Disp_Ctxt; procedure Reindent (Ctxt : Format_Disp_Ctxt.Format_Ctxt; Respace : Boolean := False) is use Format_Disp_Ctxt; -- Number of spaces for indentation. Indentation : constant Natural := 2; I : Natural; Etok : Etoken_Type; Tok : Token_Type; Col : Natural; -- Previous token. This is used to decide whether a space must be -- inserted between two tokens. Prev_Tok : Token_Type; Cur_Col : Natural; Diff_Col : Integer; Indent : Natural; Extra_Indent : Boolean; begin I := Token_Table.First; Cur_Col := 1; Indent := 1; Prev_Tok := Tok_Newline; Extra_Indent := True; Diff_Col := 0; loop Read_Token (Ctxt, I, Etok, Col); if Etok <= Etok_Last then Tok := Token_Type'Val (Etok); case Tok is when Tok_Eof => exit; when Tok_Newline => Cur_Col := 1; when Token_Source_Type | Tok_Block_Comment_Start | Tok_First_Delimiter .. Token_Type'Last => if Cur_Col = 1 then -- First token of the line, reindent it. Cur_Col := Indent; if Extra_Indent then Cur_Col := Cur_Col + Indentation; end if; Diff_Col := Cur_Col - Col; else if Respace then -- Just adjust position. if Need_Space (Tok, Prev_Tok) then Cur_Col := Cur_Col + 1; end if; else Cur_Col := Col + Diff_Col; end if; end if; Write_Token (Ctxt, I, Cur_Col); if Tok /= Tok_Line_Comment and then Tok /= Tok_Block_Comment_Start then -- If there is a new line in the current hbox, add an -- extra indentation. Extra_Indent := True; end if; when Tok_Block_Comment_Text | Tok_Block_Comment_End => null; when Tok_Invalid => raise Internal_Error; end case; case Tok is when Tok_Eof | Tok_Invalid => raise Internal_Error; when Tok_Newline => I := I + 1; when Token_Source_Type | Tok_Block_Comment_Text => if Respace then -- Increment column by the length of the token Cur_Col := Cur_Col + Natural (Read_Value (Ctxt, I + 1)); else -- A token is at least one character. Cur_Col := Cur_Col + 1; end if; I := I + 3; when Tok_First_Delimiter .. Token_Type'Last | Tok_Block_Comment_Start | Tok_Block_Comment_End => if Respace then declare S : constant String := Image (Tok); begin Cur_Col := Cur_Col + S'Length; end; else -- A token is at least one character. Cur_Col := Cur_Col + 1; end if; I := I + 1; end case; else case Etok is when Etok_Start_Vbox | Etok_Close_Vbox => Indent := Col * Indentation + 1; Extra_Indent := False; when Etok_Set_Vbox => Indent := Col * Indentation + 1; when Etok_No_Indent => Extra_Indent := False; when Etok_Valign => null; when others => raise Internal_Error; end case; I := I + 1; end if; Prev_Tok := Tok; end loop; end Reindent; -- Realign some token. -- For objects declarations of the same region, the colon (:), the subtype -- indication and the default value will be aligned on the same column. procedure Realign (Ctxt : in out Format_Disp_Ctxt.Format_Ctxt; Vbox : in out Natural) is use Format_Disp_Ctxt; type Valign_Natural is array (Valign_Type) of Natural; type Valign_Boolean is array (Valign_Type) of Boolean; -- Maximum offset relative to previous alignment. Vpos : Valign_Natural; -- True when the realignment was done in the current line. Used to -- discard same alignment marker that appears later. Vdone : Valign_Boolean; I : Natural; Etok : Etoken_Type; Tok : Token_Type; Col : Natural; Skip : Natural; Valign : Valign_Type; Diff_Col : Integer; Cum_Col : Integer; Prev_Col : Integer; begin I := Vbox; Vpos := (others => 0); Vdone := (others => False); Diff_Col := 0; Prev_Col := 0; -- First pass: compute the positions loop Read_Token (Ctxt, I, Etok, Col); if Etok <= Etok_Last then Tok := Token_Type'Val (Etok); case Tok is when Tok_Eof => exit; when Tok_Invalid => raise Internal_Error; when Tok_Newline => -- Restart positions. Vdone := (others => False); Prev_Col := 0; I := I + 1; when Token_Source_Type | Tok_Block_Comment_Text => I := I + 3; when Tok_First_Delimiter .. Token_Type'Last | Tok_Block_Comment_Start | Tok_Block_Comment_End => I := I + 1; end case; else case Etok is when Etok_Start_Vbox => -- Nested vbox I := I + 1; Realign (Ctxt, I); when Etok_Close_Vbox => exit; when Etok_Set_Vbox => I := I + 1; when Etok_No_Indent => I := I + 1; when Etok_Valign => -- Ok, the serious work. Valign := Valign_Type'Val (Col); if not Vdone (Valign) then -- The first presence on this line. -- Read position of the next token. Read_Token (Ctxt, I + 1, Etok, Col); pragma Assert (Etok <= Etok_Last); Vdone (Valign) := True; Diff_Col := Col - Prev_Col; if Vpos (Valign) < Diff_Col then Vpos (Valign) := Diff_Col; end if; Prev_Col := Col; end if; I := I + 1; when others => raise Internal_Error; end case; end if; end loop; -- Second pass: adjust the offsets I := Vbox; Vdone := (others => False); Diff_Col := 0; Skip := 0; Cum_Col := 0; loop Read_Token (Ctxt, I, Etok, Col); if Etok <= Etok_Last then Tok := Token_Type'Val (Etok); case Tok is when Tok_Eof => Vbox := I; exit; when Tok_Invalid => raise Internal_Error; when Tok_Newline => Vdone := (others => False); Diff_Col := 0; Cum_Col := 0; I := I + 1; when Token_Source_Type | Tok_Block_Comment_Text => if Skip = 0 then Write_Token (Ctxt, I, Col + Diff_Col); end if; I := I + 3; when Tok_First_Delimiter .. Token_Type'Last | Tok_Block_Comment_Start | Tok_Block_Comment_End => if Skip = 0 then Write_Token (Ctxt, I, Col + Diff_Col); end if; I := I + 1; end case; else case Etok is when Etok_Start_Vbox => -- Nested vbox Skip := Skip + 1; when Etok_Close_Vbox => if Skip = 0 then Vbox := I + 1; exit; else Skip := Skip - 1; end if; when Etok_Set_Vbox => null; when Etok_No_Indent => null; when Etok_Valign => -- Ok, the serious work. if Skip = 0 then Valign := Valign_Type'Val (Col); if Vpos (Valign) /= 0 and then not Vdone (Valign) then Vdone (Valign) := True; Cum_Col := Cum_Col + Vpos (Valign); Read_Token (Ctxt, I + 1, Etok, Col); Diff_Col := Cum_Col - Col; end if; end if; when others => raise Internal_Error; end case; I := I + 1; end if; end loop; end Realign; procedure Realign (Ctxt : in out Format_Disp_Ctxt.Format_Ctxt) is I : Natural; begin I := Format_Disp_Ctxt.Token_Table.First; Realign (Ctxt, I); end Realign; type IO_Printer_Ctxt is new Format_Disp_Ctxt.Printer_Ctxt with null record; procedure Put (Ctxt : in out IO_Printer_Ctxt; C : Character) is pragma Unreferenced (Ctxt); begin if C = ASCII.LF then Simple_IO.New_Line; else Simple_IO.Put (C); end if; end Put; procedure Reprint (Ctxt : Format_Disp_Ctxt.Format_Ctxt; Prnt : in out Format_Disp_Ctxt.Printer_Ctxt'Class) is use Format_Disp_Ctxt; Sfe : constant Source_File_Entry := Get_Source_File_Entry (Ctxt); I : Natural; Etok : Etoken_Type; Tok : Token_Type; Col : Natural; Cur_Col : Natural; begin I := Token_Table.First; Cur_Col := 1; loop Read_Token (Ctxt, I, Etok, Col); I := I + 1; if Flags.Verbose then declare use Simple_IO; use Utils_IO; begin Put (' '); if Etok <= Etok_Last then Put (Image (Token_Type'Val (Etok))); else case Etok is when Etok_Start_Vbox => Put ("["); when Etok_Close_Vbox => Put ("]"); when Etok_Set_Vbox => Put ("V"); when Etok_No_Indent => Put ("B"); when Etok_Valign => Put ("A"); when others => raise Internal_Error; end case; end if; Put (':'); Put_Int32 (Nat32 (Col)); Put ('@'); Put_Int32 (Nat32 (I - 1)); end; end if; while Cur_Col < Col loop Prnt.Put (' '); Cur_Col := Cur_Col + 1; end loop; if Etok <= Etok_Last then Tok := Token_Type'Val (Etok); case Tok is when Tok_Eof => exit; when Tok_Newline => Prnt.Put (ASCII.LF); Cur_Col := 1; when Token_Source_Type | Tok_Block_Comment_Text => declare Buf : constant File_Buffer_Acc := Files_Map.Get_File_Source (Sfe); Len : Nat32; Pos : Source_Ptr; begin Len := Read_Value (Ctxt, I); Pos := Source_Ptr (Read_Value (Ctxt, I + 1)); for K in 0 .. Len - 1 loop Prnt.Put (Buf (Pos + Source_Ptr (K))); end loop; Cur_Col := Cur_Col + Natural (Len); I := I + 2; end; when Tok_First_Delimiter .. Token_Type'Last | Tok_Block_Comment_Start | Tok_Block_Comment_End => declare S : constant String := Image (Tok); begin for I in S'Range loop Prnt.Put (S (I)); end loop; Cur_Col := Cur_Col + S'Length; end; when Tok_Invalid => null; end case; end if; end loop; end Reprint; procedure Format_Init (F : Iir_Design_File; First_Line : Positive := 1; Last_Line : Positive := Positive'Last; Ctxt : out Format_Disp_Ctxt.Format_Ctxt) is use Format_Disp_Ctxt; Sfe : constant Source_File_Entry := Get_Design_File_Source (F); begin Scanner.Flag_Comment := True; Scanner.Flag_Newline := True; Set_File (Sfe); Scan; Init (Ctxt, Sfe, First_Line, Last_Line); Prints.Disp_Vhdl (Ctxt, F); Close_File; Scanner.Flag_Comment := False; Scanner.Flag_Newline := False; Append_Eof (Ctxt); end Format_Init; procedure Format (F : Iir_Design_File; Level : Format_Level; Flag_Realign : Boolean; First_Line : Positive := 1; Last_Line : Positive := Positive'Last) is use Format_Disp_Ctxt; Ctxt : Format_Ctxt; Prnt : IO_Printer_Ctxt; begin Format_Init (F, First_Line, Last_Line, Ctxt); if Level > Format_None then Reindent (Ctxt, Level = Format_Space); end if; if Flag_Realign then Realign (Ctxt); end if; Reprint (Ctxt, Prnt); Free (Ctxt); end Format; procedure Dump_Fmt (Ctxt : Format_Disp_Ctxt.Format_Ctxt) is Prnt : IO_Printer_Ctxt; begin Reprint (Ctxt, Prnt); end Dump_Fmt; pragma Unreferenced (Dump_Fmt); function Allocate_Handle return Vstring_Acc is begin return new Grt.Vstrings.Vstring; end Allocate_Handle; function Get_Length (Handle : Vstring_Acc) return Natural is begin return Grt.Vstrings.Length (Handle.all); end Get_Length; function Get_C_String (Handle : Vstring_Acc) return Grt.Types.Ghdl_C_String is begin return Grt.Vstrings.Get_C_String (Handle.all); end Get_C_String; procedure Free_Handle (Handle : Vstring_Acc) is procedure Deallocate is new Ada.Unchecked_Deallocation (Grt.Vstrings.Vstring, Vstring_Acc); Handle1 : Vstring_Acc; begin Grt.Vstrings.Free (Handle.all); Handle1 := Handle; Deallocate (Handle1); end Free_Handle; type Vstring_Printer_Ctxt is new Format_Disp_Ctxt.Printer_Ctxt with record Handle : Vstring_Acc; end record; procedure Put (Ctxt : in out Vstring_Printer_Ctxt; C : Character) is begin Grt.Vstrings.Append (Ctxt.Handle.all, C); end Put; procedure Indent_String (F : Iir_Design_File; Handle : Vstring_Acc; First_Line : Positive := 1; Last_Line : Positive := Positive'Last) is use Format_Disp_Ctxt; Ctxt : Format_Ctxt; Prnt : Vstring_Printer_Ctxt; begin Format_Init (F, First_Line, Last_Line, Ctxt); Prnt := (Format_Disp_Ctxt.Printer_Ctxt with Handle); Reindent (Ctxt, False); Realign (Ctxt); Reprint (Ctxt, Prnt); Free (Ctxt); end Indent_String; end Vhdl.Formatters;