Pascal ** definition (exponent) - operators

I was looking for the definition in Extended Pascal for the ** exponentiation operation. I've been looking for awhile now and can't seem to find it.
i.e 2**3 = 8

In FreePascal it is implemented in the math unit:
operator ** (bas,expo : float) e: float; inline;
begin
e:=power(bas,expo);
end;
operator ** (bas,expo : int64) i: int64; inline;
begin
i:=round(intpower(bas,expo));
end;
function power(base,exponent : float) : float;
begin
if Exponent=0.0 then
result:=1.0
else if (base=0.0) and (exponent>0.0) then
result:=0.0
else if (abs(exponent)<=maxint) and (frac(exponent)=0.0) then
result:=intpower(base,trunc(exponent))
else if base>0.0 then
result:=exp(exponent * ln (base))
else
InvalidArgument;
end;
function intpower(base : float;const exponent : Integer) : float;
var
i : longint;
begin
if (base = 0.0) and (exponent = 0) then
result:=1
else
begin
i:=abs(exponent);
intpower:=1.0;
while i>0 do
begin
while (i and 1)=0 do
begin
i:=i shr 1;
base:=sqr(base);
end;
i:=i-1;
intpower:=intpower*base;
end;
if exponent<0 then
intpower:=1.0/intpower;
end;
end;

Related

How do you set the glass blend colour on Windows 10?

Using the undocumented SetWindowCompositionAttribute API on Windows 10, it's possible to enable glass for a window. The glass is white or clear, as seen in this screenshot:
However, the Windows 10 Start menu and the notification center, which both also uses glass, both blend with the accent colour, like so:
How does it do it?
Investigations
The accent colour in the following examples is a light purple - here's a screenshot from the Settings app:
The AccentPolicy structure defined in this example code has accent state, flags and gradient color fields:
AccentPolicy = packed record
AccentState: Integer;
AccentFlags: Integer;
GradientColor: Integer;
AnimationId: Integer;
end;
and the state can have any of these values:
ACCENT_ENABLE_GRADIENT = 1;
ACCENT_ENABLE_TRANSPARENTGRADIENT = 2;
ACCENT_ENABLE_BLURBEHIND = 3;
Note that the first two of these were found on this github gist.
The third works fine - that enables glass. Of the other two,
ACCENT_ENABLE_GRADIENT results in a window that is completely gray, regardless of what is behind it. There is no transparency or glass effect, but the window colour being drawn is being drawn by the DWM, not by the app.
ACCENT_ENABLE_TRANSPARENTGRADIENT results in a window that is painted completely with the accent colour, regardless of what is behind it. There is no transparency or glass effect, but the window colour being drawn is being drawn by the DWM, not by the app.
So this is getting close, and it seems to be what some of the popup windows like the volume control applet use.
The values can't be or-ed together, and the value of the GradientColor field has no effect except that it must be non-zero.
Drawing directly on a glass-enabled window results in very odd blending. Here it's filling the client area with red (0x000000FF in ABGR format):
and any non-zero alpha, eg 0xAA0000FF, results in no colour at all:
Neither match the look of the Start menu or notification area.
How do those windows do it?
Since GDI forms on Delphi don't support alpha channels (unless using alpha layered windows, which might not be suitable), commonly the black color will be taken as the transparent one, unless the component supports alpha channels.
tl;dr Just use your TTransparentCanvas class, .Rectangle(0,0,Width+1,Height+1,222), using the color obtained with DwmGetColorizationColor that you could blend with a dark color.
The following will use TImage component instead.
I'm going to use a TImage and TImage32 (Graphics32) to show the difference with alpha channels. This is a borderless form, because borders won't accept our colorization.
As you can see, the left one is using TImage1 and is affected by Aero Glass, and the right one is using TGraphics32, which allows to overlay with opaque colors (no translucent).
Now, we will be using a TImage1 with a translucent PNG that we can create with the following code:
procedure SetAlphaColorPicture(
const Col: TColor;
const Alpha: Integer;
Picture: TPicture;
const _width: Integer;
const _height: Integer
);
var
png: TPngImage;
x,y: integer;
sl: pByteArray;
begin
png := TPngImage.CreateBlank(COLOR_RGBALPHA, 8, _width, _height);
try
png.Canvas.Brush.Color := Col;
png.Canvas.FillRect(Rect(0,0,_width,_height));
for y := 0 to png.Height - 1 do
begin
sl := png.AlphaScanline[y];
FillChar(sl^, png.Width, Alpha);
end;
Picture.Assign(png);
finally
png.Free;
end;
end;
We need to add another TImage component to our form and send it back so other components won't be below it.
SetAlphaColorPicture(clblack, 200, Image1.Picture, 10,10 );
Image1.Align := alClient;
Image1.Stretch := True;
Image1.Visible := True;
And that's is how our form will look like the Start Menu.
Now, to get the accent color use DwmGetColorizationColor, which is already defined in DwmAPI.pas
function TForm1.GetAccentColor:TColor;
var
col: cardinal;
opaque: longbool;
newcolor: TColor;
a,r,g,b: byte;
begin
DwmGetColorizationColor(col, opaque);
a := Byte(col shr 24);
r := Byte(col shr 16);
g := Byte(col shr 8);
b := Byte(col);
newcolor := RGB(
round(r*(a/255)+255-a),
round(g*(a/255)+255-a),
round(b*(a/255)+255-a)
);
Result := newcolor;
end;
However, that color won't be dark enough as shown by the Start Menu.
So we need to blend the accent color with a dark color:
//Credits to Roy M Klever http://rmklever.com/?p=116
function TForm1.BlendColors(Col1, Col2: TColor; A: Byte): TColor;
var
c1,c2: LongInt;
r,g,b,v1,v2: byte;
begin
A := Round(2.55 * A);
c1 := ColorToRGB(Col1);
c2 := ColorToRGB(Col2);
v1 := Byte(c1);
v2 := Byte(c2);
r := A * (v1 - v2) shr 8 + v2;
v1 := Byte(c1 shr 8);
v2 := Byte(c2 shr 8);
g := A * (v1 - v2) shr 8 + v2;
v1 := Byte(c1 shr 16);
v2 := Byte(c2 shr 16);
b := A * (v1 - v2) shr 8 + v2;
Result := (b shl 16) + (g shl 8) + r;
end;
...
SetAlphaColorPicture(BlendColors(GetAccentColor, clBlack, 50) , 222, Image1.Picture, 10, 10);
And this is the result blending clBlack with the Accent color by 50%:
There are other things that you might want to add, like for example detecting when the accent color changes and automatically update our app color too, for example:
procedure WndProc(var Message: TMessage);override;
...
procedure TForm1.WndProc(var Message: TMessage);
const
WM_DWMCOLORIZATIONCOLORCHANGED = $0320;
begin
if Message.Msg = WM_DWMCOLORIZATIONCOLORCHANGED then
begin
// here we update the TImage with the new color
end;
inherited WndProc(Message);
end;
To maintain consistency with Windows 10 start menu settings, you can read the registry to find out if the Taskbar/StartMenu is translucent (enabled) and the start menu is enabled to use the accent color or just a black background, to do so this keys will tell us:
'SOFTWARE\Microsoft\Windows\CurrentVersion\Themes\Personalize'
ColorPrevalence = 1 or 0 (enabled / disabled)
EnableTransparency = 1 or 0
This is the full code, you need TImage1, TImage2, for the colorization, the other ones are not optional.
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, GR32_Image, DWMApi, GR32_Layers,
Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Imaging.pngimage, Registry;
type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
Image3: TImage;
Image321: TImage32;
procedure FormCreate(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
function TaskbarAccented:boolean;
function TaskbarTranslucent:boolean;
procedure EnableBlur;
function GetAccentColor:TColor;
function BlendColors(Col1, Col2: TColor; A: Byte): TColor;
procedure WndProc(var Message: TMessage);override;
procedure UpdateColorization;
public
{ Public declarations }
end;
AccentPolicy = packed record
AccentState: Integer;
AccentFlags: Integer;
GradientColor: Integer;
AnimationId: Integer;
end;
TWinCompAttrData = packed record
attribute: THandle;
pData: Pointer;
dataSize: ULONG;
end;
var
Form1: TForm1;
var
SetWindowCompositionAttribute: function (Wnd: HWND; const AttrData: TWinCompAttrData): BOOL; stdcall = Nil;
implementation
{$R *.dfm}
procedure SetAlphaColorPicture(
const Col: TColor;
const Alpha: Integer;
Picture: TPicture;
const _width: Integer;
const _height: Integer
);
var
png: TPngImage;
x,y: integer;
sl: pByteArray;
begin
png := TPngImage.CreateBlank(COLOR_RGBALPHA, 8, _width, _height);
try
png.Canvas.Brush.Color := Col;
png.Canvas.FillRect(Rect(0,0,_width,_height));
for y := 0 to png.Height - 1 do
begin
sl := png.AlphaScanline[y];
FillChar(sl^, png.Width, Alpha);
end;
Picture.Assign(png);
finally
png.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.EnableBlur;
const
WCA_ACCENT_POLICY = 19;
ACCENT_ENABLE_BLURBEHIND = 3;
DrawLeftBorder = $20;
DrawTopBorder = $40;
DrawRightBorder = $80;
DrawBottomBorder = $100;
var
dwm10: THandle;
data : TWinCompAttrData;
accent: AccentPolicy;
begin
dwm10 := LoadLibrary('user32.dll');
try
#SetWindowCompositionAttribute := GetProcAddress(dwm10, 'SetWindowCompositionAttribute');
if #SetWindowCompositionAttribute <> nil then
begin
accent.AccentState := ACCENT_ENABLE_BLURBEHIND ;
accent.AccentFlags := DrawLeftBorder or DrawTopBorder or DrawRightBorder or DrawBottomBorder;
data.Attribute := WCA_ACCENT_POLICY;
data.dataSize := SizeOf(accent);
data.pData := #accent;
SetWindowCompositionAttribute(Handle, data);
end
else
begin
ShowMessage('Not found Windows 10 blur API');
end;
finally
FreeLibrary(dwm10);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
BlendFunc: TBlendFunction;
bmp: TBitmap;
begin
DoubleBuffered := True;
Color := clBlack;
BorderStyle := bsNone;
if TaskbarTranslucent then
EnableBlur;
UpdateColorization;
(*BlendFunc.BlendOp := AC_SRC_OVER;
BlendFunc.BlendFlags := 0;
BlendFunc.SourceConstantAlpha := 96;
BlendFunc.AlphaFormat := AC_SRC_ALPHA;
bmp := TBitmap.Create;
try
bmp.SetSize(Width, Height);
bmp.Canvas.Brush.Color := clRed;
bmp.Canvas.FillRect(Rect(0,0,Width,Height));
Winapi.Windows.AlphaBlend(Canvas.Handle, 50,50,Width, Height,
bmp.Canvas.Handle, 0, 0, bmp.Width, bmp.Height, BlendFunc);
finally
bmp.Free;
end;*)
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
Perform(WM_SYSCOMMAND, $F012, 0);
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
Perform(WM_SYSCOMMAND, $F012, 0);
end;
function TForm1.TaskbarAccented: boolean;
var
reg: TRegistry;
begin
Result := False;
reg := TRegistry.Create;
try
reg.RootKey := HKEY_CURRENT_USER;
reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\Themes\Personalize');
try
if reg.ReadInteger('ColorPrevalence') = 1 then
Result := True;
except
Result := False;
end;
reg.CloseKey;
finally
reg.Free;
end;
end;
function TForm1.TaskbarTranslucent: boolean;
var
reg: TRegistry;
begin
Result := False;
reg := TRegistry.Create;
try
reg.RootKey := HKEY_CURRENT_USER;
reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\Themes\Personalize');
try
if reg.ReadInteger('EnableTransparency') = 1 then
Result := True;
except
Result := False;
end;
reg.CloseKey;
finally
reg.Free;
end;
end;
procedure TForm1.UpdateColorization;
begin
if TaskbarTranslucent then
begin
if TaskbarAccented then
SetAlphaColorPicture(BlendColors(GetAccentColor, clBlack, 50) , 222, Image1.Picture, 10, 10)
else
SetAlphaColorPicture(clblack, 222, Image1.Picture, 10,10 );
Image1.Align := alClient;
Image1.Stretch := True;
Image1.Visible := True;
end
else
Image1.Visible := False;
end;
function TForm1.GetAccentColor:TColor;
var
col: cardinal;
opaque: longbool;
newcolor: TColor;
a,r,g,b: byte;
begin
DwmGetColorizationColor(col, opaque);
a := Byte(col shr 24);
r := Byte(col shr 16);
g := Byte(col shr 8);
b := Byte(col);
newcolor := RGB(
round(r*(a/255)+255-a),
round(g*(a/255)+255-a),
round(b*(a/255)+255-a)
);
Result := newcolor;
end;
//Credits to Roy M Klever http://rmklever.com/?p=116
function TForm1.BlendColors(Col1, Col2: TColor; A: Byte): TColor;
var
c1,c2: LongInt;
r,g,b,v1,v2: byte;
begin
A := Round(2.55 * A);
c1 := ColorToRGB(Col1);
c2 := ColorToRGB(Col2);
v1 := Byte(c1);
v2 := Byte(c2);
r := A * (v1 - v2) shr 8 + v2;
v1 := Byte(c1 shr 8);
v2 := Byte(c2 shr 8);
g := A * (v1 - v2) shr 8 + v2;
v1 := Byte(c1 shr 16);
v2 := Byte(c2 shr 16);
b := A * (v1 - v2) shr 8 + v2;
Result := (b shl 16) + (g shl 8) + r;
end;
procedure TForm1.WndProc(var Message: TMessage);
//const
// WM_DWMCOLORIZATIONCOLORCHANGED = $0320;
begin
if Message.Msg = WM_DWMCOLORIZATIONCOLORCHANGED then
begin
UpdateColorization;
end;
inherited WndProc(Message);
end;
initialization
SetWindowCompositionAttribute := GetProcAddress(GetModuleHandle(user32), 'SetWindowCompositionAttribute');
end.
Here is the source code and demo binary hope it helps.
I hope there is a better way, and if there is, please let us know.
BTW on C# and WPF it is easier, but those apps are very slow on cold start.
AccentPolicy.GradientColor has effect when you play with AccentPolicy.AccentFlags, I found these values:
2 - fills window with AccentPolicy.GradientColor - what you need
4 - makes area to the right and bottom of the window blurred (weird)
6 - combination of above: fills whole screen with AccentPolicy.GradientColor and blurs area like 4
To set AccentPolicy.GradientColor property, you'll need ActiveCaption and InactiveCaption system colours. I would try Rafael's suggestion to use GetImmersiveColor* family of functions. Also there is a question for Vista/7.
Note: I tried drawing with GDI+ and saw that FillRectangle() works incorrectly with Glass when brush.alpha==0xFF (workarounds here). Inner rectangles have brush.alpha==0xFE on both screenshots because of this bug.
Screenshots note: GradientColor==0x80804000, it doesn't have to be premultiplied, just a coincidence.
Just add transparent colored component to the form. I have selfwriten component like TPanel (on Delphi).
Here Alpha = 40%:

Pascal's Triangle output alignment

So I've come up with the code to the values of the triangle itself. What I'm currently strugling is how to aligne/center the values that are printed. I tried many things but, I could use some help now. If anyone has an idea how this can be done feel free to share! Thank you
Program Tri_pas;
Uses Crt;
Var
linha,ordem,a,b: byte;
Function fat(X: byte): real; // factorial
Var fat1: real;
Begin
fat1:=1;
If X <= 1 Then
fat:=1
Else
Begin
Repeat
fat1:=(fat1 * X);
X:=(X - 1);
Until X <= 1;
fat:=fat1;
End;
End;
Procedure nCp(n,p: byte); //Combinations
Var
i: byte;
nCp: real;
Begin
If n < 1 Then
n:=0
Else
n:=(n-1);
For i:=0 to n do
Begin
writeln;
For p:=0 to i do
Begin
nCp:= fat(i) / (fat(p) * fat(i - p)); // mathematic formula for the combinations
Write(nCp:1:0,' ');
End;
End;
End;
{ Main Programa }
Begin
Write('Insert a line(1 -> n) : ');
Readln(linha);
nCp(linha,ordem);
readln;
End.
Just add appropriate number of empty spaces before strings. Note that I used double-spaces, and changed placeholder size to 4 (3+1) to make better formatting.
For p := 1 to (n - i) do
Write(' ');
For p:=0 to i do
Begin
nCp:= fat(i) / (fat(p) * fat(i - p)); // mathematic formula for the combinations
Write(nCp:3:0,' ');
End;
P.S. There are more effective ways to calculate Ncr in reasonable range without real numbers.

How to add .arc decompression to Inno Setup?

I've been trying to make an installer by Inno Setup which only supports zip/bzip/lzma/lzma2 compression methods. I packed my archive by FreeArc (output file extension is .arc but renamed it to .bin) but Inno Setup is not able to extract it. I searched on internet how to implant arc decompression into Inno Setup but all sites refer to FreeArc official website which is dead for a while.
All I need is the code to use the necessary dll files to give Inno Setup the ability to decompress arc archives plus the list of those dll files needed to do so.
I appreciate any help.
This answer has been superseded by Inno Setup - How to add cancel button to decompressing page? that uses unarc.dll instead of driving the console Arc.exe.
I'm keeping this answer, as its concept can be useful for other archive types.
See the example below. It:
takes an ARC file, embeds it to the installer
during installation, the ARC file is extracted to a temporary folder
the files from the ARC file is extracted to the target folder
#define ArcArchive "test.arc"
[Files]
Source: {#ArcArchive}; DestDir: "{tmp}"; Flags: nocompression deleteafterinstall
Source: Arc.exe; Flags: dontcopy
Source: InnoCallback.dll; Flags: dontcopy
[Code]
function BufferToAnsi(const Buffer: string): AnsiString;
var
W: Word;
I: Integer;
begin
SetLength(Result, Length(Buffer) * 2);
for I := 1 to Length(Buffer) do
begin
W := Ord(Buffer[I]);
Result[(I * 2)] := Chr(W shr 8); { high byte }
Result[(I * 2) - 1] := Chr(Byte(W)); { low byte }
end;
end;
type
TTimerProc = procedure(H: LongWord; Msg: LongWord; IdEvent: LongWord; Time: LongWord);
function SetTimer(
Wnd: LongWord; IDEvent, Elapse: LongWord; TimerFunc: LongWord): LongWord;
external 'SetTimer#user32.dll stdcall';
function KillTimer(hWnd: LongWord; uIDEvent: LongWord): BOOL;
external 'KillTimer#user32.dll stdcall';
function WrapTimerProc(Callback: TTimerProc; ParamCount: Integer): LongWord;
external 'wrapcallback#files:innocallback.dll stdcall';
var
ProgressPage: TOutputProgressWizardPage;
ProgressFileName: string;
procedure UpdateProgressProc(
H: LongWord; Msg: LongWord; Event: LongWord; Time: LongWord);
var
S: AnsiString;
L: Integer;
P: Integer;
Max: Integer;
Progress: string;
Buffer: string;
Stream: TFileStream;
Percent: Integer;
Found: Boolean;
begin
Found := False;
if not FileExists(ProgressFileName) then
begin
Log(Format('Progress file %s does not exist', [ProgressFileName]));
end
else
begin
try
{ Need shared read as the output file is locked for writting, }
{ so we cannot use LoadStringFromFile }
Stream := TFileStream.Create(ProgressFileName, fmOpenRead or fmShareDenyNone);
try
L := Stream.Size;
Max := 100*2014;
if L > Max then
begin
Stream.Position := L - Max;
L := Max;
end;
SetLength(Buffer, (L div 2) + (L mod 2));
Stream.ReadBuffer(Buffer, L);
S := BufferToAnsi(Buffer);
finally
Stream.Free;
end;
if S = '' then
begin
Log(Format('Progress file %s is empty', [ProgressFileName]));
end;
except
Log(Format('Failed to read progress from file %s - %s', [
ProgressFileName, GetExceptionMessage]));
end;
end;
if S <> '' then
begin
{ Log(S); }
P := Pos('Extracted', S);
if P > 0 then
begin
Log('Extraction done');
Percent := 100;
Found := True;
end
else
begin
P := Pos('%', S);
if P > 0 then
begin
repeat
Progress := Copy(S, 1, P - 1);
Delete(S, 1, P);
P := Pos('%', S);
until (P = 0);
P := Length(Progress);
while (P > 0) and
(((Progress[P] >= '0') and (Progress[P] <= '9')) or
(Progress[P] = '.')) do
begin
Dec(P);
end;
Progress := Copy(Progress, P + 1, Length(Progress) - P);
P := Pos('.', Progress);
if P > 0 then
begin
Progress := Copy(Progress, 1, P - 1);
end;
Percent := StrToInt(Progress);
Log(Format('Percent: %d', [Percent]));
Found := True;
end;
end;
end;
if not Found then
begin
Log('No new data found');
{ no new progress data, at least pump the message queue }
ProgressPage.SetProgress(ProgressPage.ProgressBar.Position, 100);
end
else
begin
ProgressPage.SetProgress(Percent, 100);
ProgressPage.SetText(Format('Extracted: %d%%', [Percent]), '');
end;
end;
procedure ExtractArc;
var
ArcExtracterPath: string;
ArcArchivePath: string;
TempPath: string;
CommandLine: string;
Timer: LongWord;
ResultCode: Integer;
S: AnsiString;
Message: string;
begin
ExtractTemporaryFile('Arc.exe');
ProgressPage := CreateOutputProgressPage('Decompression', 'Decompressing archive...');
ProgressPage.SetProgress(0, 100);
ProgressPage.Show;
try
Timer := SetTimer(0, 0, 250, WrapTimerProc(#UpdateProgressProc, 4));
TempPath := ExpandConstant('{tmp}');
ArcExtracterPath := TempPath + '\Arc.exe';
ArcArchivePath := TempPath + '\{#ArcArchive}';
ProgressFileName := ExpandConstant('{tmp}\progress.txt');
Log(Format('Expecting progress in %s', [ProgressFileName]));
CommandLine :=
Format('"%s" x -y -o+ -dp"%s" "%s" > "%s"', [
ArcExtracterPath, ExpandConstant('{app}'), ArcArchivePath, ProgressFileName]);
Log(Format('Executing: %s', [CommandLine]));
CommandLine := Format('/C "%s"', [CommandLine]);
if not Exec(ExpandConstant('{cmd}'), CommandLine, '', SW_HIDE,
ewWaitUntilTerminated, ResultCode) then
begin
RaiseException('Cannot start extracter');
end
else
if ResultCode <> 0 then
begin
LoadStringFromFile(ProgressFileName, S);
Message := Format('Arc extraction failed failed with code %d', [ResultCode]);
Log(Message);
Log('Output: ' + S);
RaiseException(Message);
end
else
begin
Log('Arc extraction done');
end;
finally
{ Clean up }
Log('Arc extraction cleanup');
KillTimer(0, Timer);
ProgressPage.Hide;
DeleteFile(ProgressFileName);
end;
Log('Arc extraction end');
end;
procedure CurStepChanged(CurStep: TSetupStep);
begin
if CurStep = ssPostInstall then
begin
ExtractArc;
end;
end;
The code needs Unicode Inno Setup, InnoTools InnoCallback and arc.exe (I've taken it from PeaZip portable package).
Alternatively, to avoid double extraction, you can distribute the arc file along the installer.
Just use {src} to resolve its path:
ArcArchivePath := ExpandConstant('{src}\{#ArcArchive}');
And remove the {#ArcArchive} entry from the [Files] section.
It would be more robust to implement the extraction using unarc.dll, like seen in the FreeArc+InnoSetup package ISFreeArcExtract v.4.0.rar.
Freearc Actually Comes with Inno Extraction Example
http://freearc2.azurewebsites.net/InnoSetup.aspx

Can Vivado handle user defined physical types?

I wrote some cross platform VHDL libraries for Xilinx XST, iSim, Altera Quartus II, Mentor Graphics QuestaSim and GHDL. Now I wanted to port my ISE 14.7 project, which uses these libraries to Vivado 2014.4, but one library seems to have fatal problems.
My library physical defines several new user defined physical types like: FREQUENCY and BAUD; conversion functions and report functions.
One main use case is the calculation of delay or counter cycles for a given delay and system frequency. So for example a delay of 125 ns requires 12 or 13 delay cycles at 100 MHz (it depends on the rounding mode at .5).
I get several infos and warnings from Vivado Synth (some are results of an assert statement, see minimal example below):
[Synth 8-638] synthesizing module 'Top_PhysicalTest' ["D:/Temp/PhysicalTest_Vivado2014.4/vhdl/Top_PhysicalTest.vhd":410]
[Synth 8-63] RTL assertion: "to_time: f= 2147483647.1000 THz return 2147483647.1000 sec" ["D:/Temp/PhysicalTest_Vivado2014.4/vhdl/Top_PhysicalTest.vhd":277]
[Synth 8-63] RTL assertion: "res_real: 0.000000" ["D:/Temp/PhysicalTest_Vivado2014.4/vhdl/Top_PhysicalTest.vhd":321]
[Synth 8-63] RTL assertion: "TimingToCycles:
Timing: 2147483647.1000 sec
Clock_Period: 2147483647.1000 sec
RoundingStyle: TO_NEAREST
res_real = 2147483647.1000
=> 0" ["D:/Temp/PhysicalTest_Vivado2014.4/vhdl/Top_PhysicalTest.vhd":323]
[Synth 8-26] 'image of non-integer, non-enum type not implemented ["D:/Temp/PhysicalTest_Vivado2014.4/vhdl/Top_PhysicalTest.vhd":422]
[Synth 8-63] RTL assertion: "CLOCK_FREQ: <complex-type>" ["D:/Temp/PhysicalTest_Vivado2014.4/vhdl/Top_PhysicalTest.vhd":422]
[Synth 8-63] RTL assertion: "CLOCK_FREQ: 2147483647.1000 THz" ["D:/Temp/PhysicalTest_Vivado2014.4/vhdl/Top_PhysicalTest.vhd":423]
[Synth 8-26] 'image of non-integer, non-enum type not implemented ["D:/Temp/PhysicalTest_Vivado2014.4/vhdl/Top_PhysicalTest.vhd":424]
[Synth 8-63] RTL assertion: "DELAY: <complex-type>" ["D:/Temp/PhysicalTest_Vivado2014.4/vhdl/Top_PhysicalTest.vhd":424]
[Synth 8-63] RTL assertion: "DELAY: 2147483647.1000 sec" ["D:/Temp/PhysicalTest_Vivado2014.4/vhdl/Top_PhysicalTest.vhd":425]
[Synth 8-63] RTL assertion: "CYCLES: 0" ["D:/Temp/PhysicalTest_Vivado2014.4/vhdl/Top_PhysicalTest.vhd":426]
[Synth 8-256] done synthesizing module 'Top_PhysicalTest' (1#1) ["D:/Temp/PhysicalTest_Vivado2014.4/vhdl/Top_PhysicalTest.vhd":410]
[Synth 8-3330] design Top_PhysicalTest has an empty top module
[Synth 8-3331] design Top_PhysicalTest has unconnected port Clock
[Synth 8-3330] design Top_PhysicalTest has an empty top module
[Synth 8-3331] design Top_PhysicalTest has unconnected port Clock
[Project 1-571] Translating synthesized netlist
My scenario is a bit complex, so the minimal example look not as minimal as it should look. I did not inline every function to prevent copy/replace errors and I did not remove the debug and assert/report routines.
Overview:
Package utils: common types, enums and functions
Package strings: string manipulation and conversion functions
Package physical: the new type and it's functions
Entity: a single top-level entity implementing a simple delay element / shift-register
Minimal example:
-- EMACS settings: -*- tab-width: 2; indent-tabs-mode: t -*-
-- vim: tabstop=2:shiftwidth=2:noexpandtab
-- kate: tab-width 2; replace-tabs off; indent-width 2;
--
-- ============================================================================
-- Package: Common functions and types
--
-- Authors: Thomas B. Preusser
-- Martin Zabel
-- Patrick Lehmann
--
-- License:
-- ============================================================================
-- Copyright 2007-2015 Technische Universitaet Dresden - Germany
-- Chair for VLSI-Design, Diagnostics and Architecture
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
-- http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.
-- ============================================================================
library IEEE;
use IEEE.STD_LOGIC_1164.all;
use IEEE.NUMERIC_STD.all;
package utils is
-- rounding style
type T_ROUNDING_STYLE is (ROUND_TO_NEAREST, ROUND_TO_ZERO, ROUND_TO_INF, ROUND_UP, ROUND_DOWN);
function ite(cond : BOOLEAN; value1 : STRING; value2 : STRING) return STRING;
function imin(arg1 : integer; arg2 : integer) return integer;
function imax(arg1 : integer; arg2 : integer) return integer;
function log2ceil(arg : positive) return natural;
function log2ceilnz(arg : positive) return positive;
end package utils;
package body utils is
function ite(cond : BOOLEAN; value1 : STRING; value2 : STRING) return STRING is
begin
if cond then
return value1;
else
return value2;
end if;
end function;
function imin(arg1 : integer; arg2 : integer) return integer is
begin
if arg1 < arg2 then return arg1; end if;
return arg2;
end function;
function imax(arg1 : integer; arg2 : integer) return integer is
begin
if arg1 > arg2 then return arg1; end if;
return arg2;
end function;
function log2ceil(arg : positive) return natural is
variable tmp : positive := 1;
variable log : natural := 0;
begin
if arg = 1 then return 0; end if;
while arg > tmp loop
tmp := tmp * 2;
log := log + 1;
end loop;
return log;
end function;
function log2ceilnz(arg : positive) return positive is
begin
return imax(1, log2ceil(arg));
end function;
end utils;
-- ============================================================================
-- Package: String related functions and types
--
-- Authors: Thomas B. Preusser
-- Martin Zabel
-- Patrick Lehmann
--
-- =============================================================================
library IEEE;
use IEEE.STD_LOGIC_1164.all;
use IEEE.NUMERIC_STD.all;
use IEEE.MATH_REAL.all;
use work.utils.all;
package strings is
function raw_format_nat_dec(value : NATURAL) return STRING;
function str_format(value : REAL; precision : NATURAL := 3) return STRING;
FUNCTION resize(str : STRING; size : POSITIVE; FillChar : CHARACTER := NUL) RETURN STRING;
function str_length(str : STRING) return NATURAL;
function str_trim(str : STRING) return STRING;
function str_substr(str : STRING; start : INTEGER := 0; length : INTEGER := 0) return STRING;
end package strings;
package body strings is
-- raw_format_* functions
function raw_format_nat_dec(value : NATURAL) return STRING is
begin
return INTEGER'image(value);
end function;
-- str_format_* functions
function str_format(value : REAL; precision : NATURAL := 3) return STRING is
constant s : REAL := sign(value);
constant int : INTEGER := integer((value * s) - 0.5); -- force ROUND_DOWN
constant frac : INTEGER := integer((((value * s) - real(int)) * 10.0**precision) - 0.5); -- force ROUND_DOWN
constant res : STRING := raw_format_nat_dec(int) & "." & raw_format_nat_dec(frac);
begin
-- assert (not MY_VERBOSE)
-- report "str_format:" & CR &
-- " value:" & REAL'image(value) & CR &
-- " int = " & INTEGER'image(int) & CR &
-- " frac = " & INTEGER'image(frac)
-- severity note;
return ite((s < 0.0), "-" & res, res);
end function;
-- resize
FUNCTION resize(str : STRING; size : POSITIVE; FillChar : CHARACTER := NUL) RETURN STRING IS
CONSTANT MaxLength : NATURAL := imin(size, str'length);
VARIABLE Result : STRING(1 TO size) := (OTHERS => FillChar);
BEGIN
if (MaxLength > 0) then
Result(1 TO MaxLength) := str(str'low TO str'low + MaxLength - 1);
end if;
RETURN Result;
END FUNCTION;
-- String functions
FUNCTION str_length(str : STRING) RETURN NATURAL IS
VARIABLE l : NATURAL := 0;
BEGIN
FOR I IN str'range LOOP
IF (str(I) = NUL) THEN
RETURN l;
ELSE
l := l + 1;
END IF;
END LOOP;
RETURN str'length;
END FUNCTION;
function str_trim(str : STRING) return STRING is
constant len : NATURAL := str_length(str);
begin
if (len = 0) then
return "";
else
return resize(str, len);
end if;
end function;
function str_substr(str : STRING; start : INTEGER := 0; length : INTEGER := 0) return STRING is
variable StartOfString : positive;
variable EndOfString : positive;
begin
if (start < 0) then -- start is negative -> start substring at right string boundary
StartOfString := str'high + start + 1;
elsif (start = 0) then -- start is zero -> start substring at left string boundary
StartOfString := str'low;
else -- start is positive -> start substring at left string boundary + offset
StartOfString := start;
end if;
if (length < 0) then -- length is negative -> end substring at length'th character before right string boundary
EndOfString := str'high + length;
elsif (length = 0) then -- length is zero -> end substring at right string boundary
EndOfString := str'high;
else -- length is positive -> end substring at StartOfString + length
EndOfString := StartOfString + length - 1;
end if;
if (StartOfString < str'low) then report "StartOfString is out of str's range. (str=" & str & ")" severity error; end if;
if (EndOfString < str'high) then report "EndOfString is out of str's range. (str=" & str & ")" severity error; end if;
return str(StartOfString to EndOfString);
end function;
end strings;
-- ============================================================================
-- Package: This VHDL package declares new physical types and their
-- conversion functions.
--
-- Authors: Patrick Lehmann
--
-- ============================================================================
library IEEE;
use IEEE.MATH_REAL.all;
use work.utils.all;
use work.strings.all;
package physical is
type FREQ is range 0 to INTEGER'high units
Hz;
kHz = 1000 Hz;
MHz = 1000 kHz;
GHz = 1000 MHz;
THz = 1000 GHz;
end units;
constant C_PHYSICAL_REPORT_TIMING_DEVIATION : BOOLEAN := TRUE;
function to_time(f : FREQ) return TIME;
function to_real(t : TIME; scale : TIME) return REAL;
function to_real(f : FREQ; scale : FREQ) return REAL;
function TimingToCycles(Timing : TIME; Clock_Period : TIME; RoundingStyle : T_ROUNDING_STYLE := ROUND_TO_NEAREST) return NATURAL;
function TimingToCycles(Timing : TIME; Clock_Frequency : FREQ; RoundingStyle : T_ROUNDING_STYLE := ROUND_TO_NEAREST) return NATURAL;
function to_string(t : TIME; precision : NATURAL := 3) return STRING;
function to_string(f : FREQ; precision : NATURAL := 3) return STRING;
end physical;
package body physical is
-- iSim 14.7 does not support fs in simulation by default (fs values are converted to 0 ps)
-- activate fs support by overriding the time precision
-- fuse[.exe] [...] -timeprecision_vhdl 1fs [...]
function MinimalTimeResolutionInSimulation return TIME is
begin
if (1 fs > 0 sec) then return 1 fs;
elsif (1 ps > 0 sec) then return 1 ps;
elsif (1 ns > 0 sec) then return 1 ns;
elsif (1 us > 0 sec) then return 1 us;
elsif (1 ms > 0 sec) then return 1 ms;
else return 1 sec;
end if;
end function;
-- real division for physical types
function div(a : TIME; b : TIME) return REAL is
constant MTRIS : TIME := MinimalTimeResolutionInSimulation;
begin
if (a < 1 us) then
return real(a / MTRIS) / real(b / MTRIS);
elsif (a < 1 ms) then
return real(a / (1000 * MTRIS)) / real(b / MTRIS) * 1000.0;
elsif (a < 1 sec) then
return real(a / (1000000 * MTRIS)) / real(b / MTRIS) * 1000000.0;
else
return real(a / (1000000000 * MTRIS)) / real(b / MTRIS) * 1000000000.0;
end if;
end function;
function div(a : FREQ; b : FREQ) return REAL is
begin
return real(a / 1 Hz) / real(b / 1 Hz);
end function;
-- conversion functions
function to_time(f : FREQ) return TIME is
variable res : TIME;
begin
if (f < 1.0 kHz) then res := div(1.0 Hz, f) * 1.0 sec;
elsif (f < 1.0 MHz) then res := div(1.0 kHz, f) * 1.0 ms;
elsif (f < 1.0 GHz) then res := div(1.0 MHz, f) * 1.0 us;
elsif (f < 1.0 THz) then res := div(1.0 GHz, f) * 1.0 ns;
else res := div(1.0 THz, f) * 1.0 ps;
end if;
assert FALSE report "to_time: f= " & to_string(f) & " return " & to_string(res) severity note;
return res;
end function;
-- convert physical types (TIME, FREQ) to standard type (REAL)
function to_real(t : TIME; scale : TIME) return REAL is
begin
if (scale = 1.0 fs) then return div(t, 1.0 fs);
elsif (scale = 1.0 ps) then return div(t, 1.0 ps);
elsif (scale = 1.0 ns) then return div(t, 1.0 ns);
elsif (scale = 1.0 us) then return div(t, 1.0 us);
elsif (scale = 1.0 ms) then return div(t, 1.0 ms);
elsif (scale = 1.0 sec) then return div(t, 1.0 sec);
else report "to_real: scale must have a value of '1.0 <unit>'" severity failure;
end if;
end;
function to_real(f : FREQ; scale : FREQ) return REAL is
begin
if (scale = 1.0 Hz) then return div(f, 1.0 Hz);
elsif (scale = 1.0 kHz) then return div(f, 1.0 kHz);
elsif (scale = 1.0 MHz) then return div(f, 1.0 MHz);
elsif (scale = 1.0 GHz) then return div(f, 1.0 GHz);
elsif (scale = 1.0 THz) then return div(f, 1.0 THz);
else report "to_real: scale must have a value of '1.0 <unit>'" severity failure;
end if;
end;
-- calculate needed counter cycles to achieve a given 1. timing/delay and 2. frequency/period
-- ===========================================================================
-- #param Timing A given timing or delay, which should be achived
-- #param Clock_Period The period of the circuits clock
-- #RoundingStyle Default = round to nearest; other choises: ROUND_UP, ROUND_DOWN
function TimingToCycles(Timing : TIME; Clock_Period : TIME; RoundingStyle : T_ROUNDING_STYLE := ROUND_TO_NEAREST) return NATURAL is
variable res_real : REAL;
variable res_nat : NATURAL;
begin
res_real := div(Timing, Clock_Period);
case RoundingStyle is
when ROUND_TO_NEAREST => res_nat := natural(round(res_real));
when ROUND_UP => res_nat := natural(res_real + 0.5);
when ROUND_DOWN => res_nat := natural(res_real);
when others => report "RoundingStyle '" & T_ROUNDING_STYLE'image(RoundingStyle) & "' not supported." severity failure;
end case;
report "res_real: " & REAL'image(res_real) severity note;
assert FALSE
report "TimingToCycles: " & CR &
" Timing: " & to_string(Timing) & CR &
" Clock_Period: " & to_string(Clock_Period) & CR &
" RoundingStyle: " & str_substr(T_ROUNDING_STYLE'image(RoundingStyle), 7) & CR &
" res_real = " & str_format(res_real, 3) & CR &
" => " & INTEGER'image(res_nat)
severity note;
return res_nat;
end;
function TimingToCycles(Timing : TIME; Clock_Frequency : FREQ; RoundingStyle : T_ROUNDING_STYLE := ROUND_TO_NEAREST) return NATURAL is
begin
return TimingToCycles(Timing, to_time(Clock_Frequency), RoundingStyle);
end function;
-- convert and format physical types to STRING
function to_string(t : TIME; precision : NATURAL := 3) return STRING is
variable unit : STRING(1 to 3) := (others => NUL);
variable value : REAL;
begin
if (t < 1.0 ps) then
unit(1 to 2) := "fs";
value := to_real(t, 1.0 fs);
elsif (t < 1.0 ns) then
unit(1 to 2) := "ps";
value := to_real(t, 1.0 ps);
elsif (t < 1.0 us) then
unit(1 to 2) := "ns";
value := to_real(t, 1.0 ns);
elsif (t < 1.0 ms) then
unit(1 to 2) := "us";
value := to_real(t, 1.0 us);
elsif (t < 1.0 sec) then
unit(1 to 2) := "ms";
value := to_real(t, 1.0 ms);
else
unit := "sec";
value := to_real(t, 1.0 sec);
end if;
return str_format(value, precision) & " " & str_trim(unit);
end function;
function to_string(f : FREQ; precision : NATURAL := 3) return STRING is
variable unit : STRING(1 to 3) := (others => NUL);
variable value : REAL;
begin
if (f < 1.0 kHz) then
unit(1 to 2) := "Hz";
value := to_real(f, 1.0 Hz);
elsif (f < 1.0 MHz) then
unit := "kHz";
value := to_real(f, 1.0 kHz);
elsif (f < 1.0 GHz) then
unit := "MHz";
value := to_real(f, 1.0 MHz);
elsif (f < 1.0 THz) then
unit := "GHz";
value := to_real(f, 1.0 GHz);
else
unit := "THz";
value := to_real(f, 1.0 THz);
end if;
return str_format(value, precision) & " " & str_trim(unit);
end function;
end package body;
library IEEE;
use IEEE.STD_LOGIC_1164.ALL;
use IEEE.NUMERIC_STD.ALL;
use work.utils.all;
use work.strings.all;
use work.physical.all;
entity Top_PhysicalTest is
Port (
Clock : in STD_LOGIC;
Input : in STD_LOGIC;
Output : out STD_LOGIC
);
end;
architecture rtl of Top_PhysicalTest is
-- configuration
constant CLOCK_FREQ : FREQ := 100 MHz;
constant SHIFTER_DELAY : TIME := 125 ns;
-- calculations
constant SHIFTER_DELAY_CYCLES : NATURAL := TimingToCycles(SHIFTER_DELAY, CLOCK_FREQ);
constant SHIFTER_BITS : NATURAL := SHIFTER_DELAY_CYCLES + 2; -- to prevent an underrun, while Vivado has a bug
signal Shifter_nxt : STD_LOGIC_VECTOR(SHIFTER_BITS - 1 downto 0);
signal Shifter_d : STD_LOGIC_VECTOR(SHIFTER_BITS - 2 downto 0) := (others => '0');
begin
assert false report "CLOCK_FREQ: " & FREQ'image(CLOCK_FREQ) severity note;
assert false report "CLOCK_FREQ: " & to_string(CLOCK_FREQ) severity note;
assert false report "DELAY: " & TIME'image(SHIFTER_DELAY) severity note;
assert false report "DELAY: " & to_string(SHIFTER_DELAY) severity note;
assert false report "CYCLES: " & INTEGER'image(SHIFTER_DELAY_CYCLES) severity note;
Shifter_nxt <= Shifter_d & Input;
Shifter_d <= Shifter_nxt(Shifter_d'range) when rising_edge(Clock);
Output <= Shifter_nxt(SHIFTER_DELAY_CYCLES);
end;
UDPT ::= user defined physical type
My observations:
synthesis runs through without any error but causes false calculations
'image is not implemented -> How should one debug this?
seems to hold a value of INTEGER'high
Questions:
How can I fix this for Vivado?
Can anyone confirm this behavior?
Which VHDL standard (87, 93, ...) introduced physical types?
Notice: Move my question from CR to SO by hand.
Edit 1:
I stripped the errors down to:
decimal literals in physical types are false handled -> result is 0 in every case
attribute 'image(..) on physical types is not implemented any more
operations with physical types, incl. comparisons results in false values
value ranges of physical types are not monotone
The issues are reported in the Xilinx forum.
THz is out of range for the minimum range of type Time (see IEEE Std 1076-2008, 16.3 Package standard, "type INTEGER is range implementation_defined;", 5.2.3 Integer types "...An implementation may restrict the bounds of the range constraint of integer types other than type universal_integer. However, an implementation shall allow the declaration of any integer type whose range is wholly contained within the bounds –2147483647 and +2147483647 inclusive.", type FREQ).
Counting from the top, line:pos 272:65, 298:55, 384:51.
I'm not surprised at your results.
How can I fix this for Vivado?
Prescalers. Use two integers, one for a fraction part of some integer unit. Alternatively use a bit array type, which shifts the problem to one of string conversion.
It seems unlikely you'll get Xilinx to support 64 bit integers for ranges as in the type declaration:
type FREQ is range 0 to INTEGER'high units
Hz;
kHz = 1000 Hz;
MHz = 1000 kHz;
GHz = 1000 MHz;
THz = 1000 GHz;
end units;
Can anyone confirm this behavior?
The arithmetic works out, no Vivaldo. It says 32 bit integers are supported.
Which VHDL standard (87, 93, ...) introduced physical types?
As Bill Lynch notes physical types are found in IEEE Std 1076-1987, 3.1.3 Physical types, Page 3-5.
This demonstrates the advantages of using a VHDL analyzer/simulator to validate a design specification before synthesis:
ghdl -a top_physicaltest.vhdl
top_physicaltest.vhdl:272:65: static constant violates bounds
top_physicaltest.vhdl:298:55: static constant violates bounds
top_physicaltest.vhdl:384:51: static constant violates bounds
Using ghdl-0.31 I increased the HIGH bound of FREQ:
type FREQ is range 0 to 2**61 units
This works because ghdl's universal integer is 64 bit and physical types can have a universal integer range.
(There's a bug in ghdl, should work with the integer equivalent of 2**63 -1, Tristan's fixed it I think for ghdl-0.33. I happended to know 2**61 is a safe bound).
That analyzes. You could note that the Real Range limits the accuracy of any scaling your perform. Without checking I couldn't tell you if ghdl has a 64 bit universal Real to match it's 64 bit universal integer.
So then analyze, elaborate and run Top_PhysicalTest (the test bench).
ghdl -r top_physicaltest
./top_physicaltest:error: bound check failure at physical.vhdl:117
ghdl: compilation error
-- raw_format_* functions
function raw_format_nat_dec(value : NATURAL) return STRING is
begin
return INTEGER'image(value);
end function;
-- str_format_* functions
function str_format(value : REAL; precision : NATURAL := 3) return STRING is
constant s : REAL := sign(value);
constant int : INTEGER := integer((value * s) - 0.5); -- force ROUND_DOWN
constant frac : INTEGER := integer((((value * s) - real(int)) * 10.0**precision) - 0.5); -- force ROUND_DOWN
constant res : STRING := raw_format_nat_dec(int) & "." & raw_format_nat_dec(frac); -- LINE 117
begin
-- assert (not MY_VERBOSE)
-- report "str_format:" & CR &
-- " value:" & REAL'image(value) & CR &
-- " int = " & INTEGER'image(int) & CR &
-- " frac = " & INTEGER'image(frac)
-- severity note;
return ite((s < 0.0), "-" & res, res);
end function;
Where Line 117 is the declaration for constant res in the package body for package strings.
And from std.standard:
subtype NATURAL is INTEGER range 0 to INTEGER'HIGH;
Type integer is 32 bit precision in ghdl (and universally in synthesis tools).
And that looks like a 'IMAGE error I may or may not have notified Tristan of (Yup!, see #31 Type conversion subtype constraint check not performed, it's fixed for 0.33, too (gee I'm going to skip 0.32 I think)).
So I tried with nvc, which also has 64 bit universal integers, and I had previously submitted some errors to do with expressions for:
nvc -a physical.vhdl
nvc -e Top_PhysicalTest
** Fatal: expression cannot be folded to an integer constant
File physical.vhdl, Line 412
And Line 412 is in Top_PhysicalTest:
constant CLOCK_FREQ : FREQ := 100 MHz;
constant SHIFTER_DELAY : TIME := 125 ns;
-- calculations
constant SHIFTER_DELAY_CYCLES : NATURAL := TimingToCycles(SHIFTER_DELAY, CLOCK_FREQ);
constant SHIFTER_BITS : NATURAL := SHIFTER_DELAY_CYCLES + 2; -- to prevent an underrun, while Vivado has a bug
constant SHIFTER_BITS : NATURAL := SHIFTER_DELAY_CYCLES + 2; -- to prevent an underrun, while Vivado has a bug
signal Shifter_nxt : STD_LOGIC_VECTOR(SHIFTER_BITS - 1 downto 0);
The declaration for signal Shifter_nxt.
(And which looks like a different type of error).

Pascal substr equivalent

I was looking for a Pascal equivalent for (for example) the php's substr function, which works like this:
$new_string = substr('abcdef', 1, 3); // returns 'bcd'
I've already found it, but I always take excessively long to do so, so I'm posting the answer for others like me to be able to easily find it.
You can use the function copy. The syntax goes:
copy(string, start, length);
Strings in Pascal seem to be indexed starting from the 1, so the following:
s1 := 'abcdef';
s2 := copy (s1,2,3);
will result in
s2 == 'bcd'.
Hope this helps someone.
Freepascal also has a Copy function:
T:='1234567';
S:=Copy (T,1,2); { S:='12' }
S:=Copy (T,4,2); { S:='45' }
S:=Copy (T,4,8); { S:='4567' }
I recommend you see Lazarus IDE.
function substring(s: string; a, b: integer): string;
var len: integer;
procedure swap(var a, b: integer);
var temp: integer;
begin
temp:= a;
a:= b;
b:= temp;
end;
begin
if (a > b) then
swap(a, b);
len:= length(s);
if ((len = 0) or ((a < 1) and (b < 1)) or
((a > len) and (b > len))) then
begin
substring:= '';
end
else
begin
if (a < 1) then
a:= 1;
if (b > len) then
b:= len;
substring:= copy(s, a, b);
end;
end;

Resources