Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 4 days ago.
Improve this question
I want to write a pascal script to charge a battery for a specified time period or until the upper voltage limit is achieved. I also want to read the battery current and voltage at specific time interval while the charging continues.
I will supply the set voltage, set current , lower voltage limit, upper voltage limit and read the output voltage, output current parameters using a DC power supply used for this process.
program BatteryCharging;
uses DateUtils,sysUtils;
var
temp: string;
Voltage, Current: string;
OverVoltageLimit: Double;
TimeInterval: Integer;
StartTime: TDateTime;
begin
// Set parameters
temp:= 'CH 1' + #13#10;
ComSendstr(temp);
writeln(temp);
temp:= 'SO:VO 1.00' + #13#10;
ComSendstr(temp);
temp:= 'SO:CU 0.50' + #13#10;
ComSendstr(temp);
temp:= 'SO:UV 0.10' + #13#10;
ComSendstr(temp);
temp:= 'SO:OV 5.00' + #13#10;
ComSendstr(temp);
temp:= 'OUTP 1' + #13#10;
ComSendstr(temp);
// Battery charging loop
TimeInterval := 2; // set time interval to 2 seconds
while True do
begin
// read voltage and current
temp := 'VOLT?' + #13#10;
ComSendstr(temp);
Voltage := ComRecstr(20);
temp := 'CURR?' + #13#10;
ComSendstr(temp);
Current := ComRecstr(20);
temp := 'SO:OV' + #13#10;
ComSendstr(temp);
OverVoltageLimit := StrToFloat(ComRecstr(20));
StartTime :=Now;
// check if overvoltage limit has been exceeded
if StrToFloat(Voltage) >= OverVoltageLimit then
begin
writeln('Overvoltage limit exceeded. Stopping charging process.');
Break;
end;
// check if time interval has elapsed
if MilliSecondsBetween(Now, StartTime) >= TimeInterval * 1000 then
begin
// save data to file or display on screen
// you can modify this to suit your needs
writeln('Time: ', TimeToStr(Now), ' Voltage: ', Voltage, ' Current:
', Current);
// reset start time
StartTime := Now;
end;
// wait for specified time interval
Sleep(1000);
end;
temp := 'OUTP 0' + #13#10;
ComSendstr(temp);
temp := 'EXIT' + #13#10;
ComSendstr(temp);
end.
The parameter set part is working fine and the instrument accepts the set value. But there is some error in the loop. It shows error 1521. But I don't understand why?
I need to convert the timestruct I get from Beckhoffs function block "FB_LocalSystemTime" to milliseconds since epoch to receive the local computer time in milliseconds.
Unfortunately I can't find a function to convert this timestruct. Any help is appreciated.
//Local Systemtime variables
fbTime : FB_LocalSystemTime := ( bEnable := TRUE, dwCycle := 1 );
You will get miliseconds with this function:
FUNCTION F_SYSTEMTIME_TO_TIMESTRUCT : TIMESTRUCT
VAR
fbGetSystemTime : GETSYSTEMTIME; (*timestamp*)
fileTime : T_FILETIME;
sDT: STRING(30);
END_VAR
fbGetSystemTime(timeLoDW => fileTime.dwLowDateTime, timeHiDW => fileTime.dwHighDateTime);
sDT := SYSTEMTIME_TO_STRING(FILETIME_TO_SYSTEMTIME(fileTime));
F_SYSTEMTIME_TO_TIMESTRUCT.wYear := STRING_TO_WORD(LEFT(sDt, 4));
F_SYSTEMTIME_TO_TIMESTRUCT.wMonth := STRING_TO_WORD(MID(sDt, 2, 6));
F_SYSTEMTIME_TO_TIMESTRUCT.wDay := STRING_TO_WORD(MID(sDt, 2, 9));
F_SYSTEMTIME_TO_TIMESTRUCT.wHour := STRING_TO_WORD(MID(sDt, 2, 12));
F_SYSTEMTIME_TO_TIMESTRUCT.wMinute := STRING_TO_WORD(MID(sDt, 2, 15));
F_SYSTEMTIME_TO_TIMESTRUCT.wSecond := STRING_TO_WORD(MID(sDt, 2, 18));
F_SYSTEMTIME_TO_TIMESTRUCT.wMilliseconds := STRING_TO_WORD(RIGHT(sDt, 3));
I think you can use DT_TO_DINT after converting the TIMESTRUCT to DT. This should give you seconds since Jan 1, 1970.
EDIT:
This code should give you milliseconds since 1/1/1970.
PROGRAM MAIN
VAR
fbTime: FB_LocalSystemTime;
tStruct: TIMESTRUCT;
msec: DINT;
dTime: DATE_AND_TIME;
eTime_sec: DINT;
eTime_msec: LINT;
END_VAR
fbTime(bEnable:=TRUE, dwCycle:=1, SystemTime=>tStruct);
msec := tStruct.wMilliseconds;
tStruct.wMilliseconds := 0;
dTime := SYSTEMTIME_TO_DT(tStruct);
eTime_sec := DT_TO_DINT(dTime);
eTime_msec := DINT_TO_LINT(eTime_sec) * 1000 + msec;
You can use the SYSTEMTIME_TO_DT() function to convert a timestruct to dt which is a 4byte DATE_AND_TIME data type.
The smallest unit of this data type is a second though and not a millisecond.
Given that TIMESTRUCT has a millisecond value in it, you can easily use it and concatenate everything to a human readable string.
I've used function GetSystemTime() which returns number of 100ns since 1 January 1601 (god knows why). So we just need to shift up to 1/1/1970 by add 11644473600_000_000_0 (which is amount od 100ns periods between dates) and then convert 100ns periods to e.g. miliseconds by divide over 1000_0 or seconds by divide them over 1_000_000_0. Remember that's a UTC time, if You want to get local time use FB_LocalSystemTime and timestruct conversion as #kolyur mentioned.
FUNCTION GET_UNIX_EPOCH : ULINT
GET_UNIX_EPOCH := (F_GetSystemTime() - 116444736000000000) / 10000;
I have a task to write a program in Pascal. When I run the program, the result was exitcode 201.
I don't know how to fix this error.
program convertTime;
uses crt;
Type
Jam = record
hh:integer ;
mm:integer ;
ss:integer;
end;
var
J : Jam;
P,totaldetik,sisa : integer;
begin
J.hh:= 16;
J.mm:= 10;
J.ss:= 34;
write('masukkan waktu(menit): ');read(p);
totaldetik:= (J.hh*3600) + (J.mm*60) + J.ss + (p*60);
J.hh:= totaldetik div 3600;
sisa:= totaldetik mod 3600 ;
J.mm:= sisa div 60;
J.ss:= sisa mod 60;
writeln('total the time: ',J.hh,' Hour ',J.mm,' Minute ',J.ss,' second');
readln;
end.
As seen in other questions, the error code 201 is a range check error. Put simply, a value's trying to be stored where it doesn't fit.
If, as in the linked question, you're using the Free Pascal Compiler, integer variables are 16-bit values – they can't go higher than
32,767.
Your totaldetik variable looks like it would often be higher than the limit for an integer value, so you'll need a larger variable to store it in. Try making totaldetik a longint instead.
I am wondering how to convert an integer to a long_integer and a long_integer to a Positive_Count. Every way I have tried has given me and error even though the conversion should be easy in that instance.
For example, doing
long := long_integer(int1) + long_integer(int2);
will make long a negative value sometimes even though both integer were positive.
The code of the function I'm running , steps split for debugging:
--calcKey--
procedure calcKey(x: in String16; key: out External_IO.Positive_Count) is
s1, s2 : String2;
int1, int2 : integer;
long1, long2 : long_integer;
begin
s1 := x(12..13);
s2 := x(15..16);
put_line("s1: " &s1& "- s2: " &s2);
int1 := abs StringToInt(s1);
int2 := abs StringToInt(s2);
put("int1: " & Integer'image(int1) & " | int: " & Integer'Image(int2)); new_line;
long1 := long_integer(int1);
long2 := long_integer(int2);
long1 := long1 + long2;
put_line("long := " & long_integer'Image(long1));
long1 := (long1 mod 256) + 1;
key := External_IO.Positive_Count(long1);
put_line("Key : " & External_IO.Positive_Count'Image(key));
new_line;
end calcKey;
calling the function:
calcKey("0123456789abcdef",k);
calcKey("0123456789abcdef",k);
calcKey("0123456789abcdef",k);
calcKey("0123456789abcdef",k);
calcKey("fedvba9876543210",k);
calcKey("fedvba9876543210",k);
The output:
s1: bc- s2: ef
int1: 2011929758 | int: 1667393125
long := -615644413
Key : 4
s1: bc- s2: ef
int1: 287586 | int: 1667393125
long := 1667680711
Key : 200
s1: bc- s2: ef
int1: 13132642 | int: 1667393125
long := 1680525767
Key : 200
s1: bc- s2: ef
int1: 13132642 | int: 1667393125
long := 1680525767
Key : 200
s1: 43- s2: 10
int1: 13120308 | int: 859058225
long := 872178533
Key : 102
s1: 43- s2: 10
int1: 6697780 | int: 859058225
long := 865756005
Key : 102
Previous answer is correct on the need (and correct way) to check integer sizes.
Alternatively, define your own integer types and be done with the "problem"!
But if integer addition is overflowing and returning negative numbers, you are not using an Ada compiler!
It is unfortunate that Gnat is not an Ada compiler by default.
With Gnat, you need to set compiler flags to enable checks such as overflow, that really ought to be on by default. Then such an overflow will raise the Constraint_Error exception with a message pointing directly at the line of code which failed - makes testing much easier than having to reverse-engineer what went wrong!
gnatmake -gnataeEfoUv -fstack-check my_main.adb
is a fairly comprehensive set, that probably includes some style checks you don't want : check the Gnat documentation for more details.
Other suggestions for preferred flag sets welcome.
If you are using another compiler, I'd be interested to hear which it is.
Incidentally, you haven't provided the StringToInt function so nobody else can test your example, but I would point out that the values it is generating are quite unlike the values I would expect from the strings you provide... is it a random hash generator?
(THis should be a comment, but it's too long so I'm submitting it as an answer)
First thing I would do is actually verify that long_int is what you think it is, i.e doing INTEGER'SIZE and LONG_INTEGER'SIZE, it could very well be that on your platform they are the very same size,
From the Ada definition:
Note that the ranges and sizes of these types can be different in
every platform (except of course for Boolean and
[[Wide_]Wide_]Character). There is an implementation requirement that
the size of type Integer is at least 16 bits, and that of Long_Integer
at least 32 bits (if present) RM 3.5.4 (21..22) (Annotated). So if you
want full portability of your types, do not use types from Standard
(except where you must, see below), rather define you own types. A
compiler will reject any type declaration whose range it cannot
satisfy.
If they are the same size you could be overflowing when you add 2 really large ints, thus giving the results you see.
Source: http://en.wikibooks.org/wiki/Ada_Programming/Libraries/Standard
I was trying to speed up a certain routine in an application, and my profiler, AQTime, identified one method in particular as a bottleneck. The method has been with us for years, and is part of a "misc"-unit:
function cwLeftPad(aString:string; aCharCount:integer; aChar:char): string;
var
i,vLength:integer;
begin
Result := aString;
vLength := Length(aString);
for I := (vLength + 1) to aCharCount do
Result := aChar + Result;
end;
In the part of the program that I'm optimizing at the moment the method was called ~35k times, and it took a stunning 56% of the execution time!
It's easy to see that it's a horrible way to left-pad a string, so I replaced it with
function cwLeftPad(const aString:string; aCharCount:integer; aChar:char): string;
begin
Result := StringOfChar(aChar, aCharCount-length(aString))+aString;
end;
which gave a significant boost. Total running time went from 10,2 sec to 5,4 sec. Awesome! But, cwLeftPad still accounts for about 13% of the total running time. Is there an easy way to optimize this method further?
Your new function involves three strings, the input, the result from StringOfChar, and the function result. One of them gets destroyed when your function returns. You could do it in two, with nothing getting destroyed or re-allocated.
Allocate a string of the total required length.
Fill the first portion of it with your padding character.
Fill the rest of it with the input string.
Here's an example:
function cwLeftPad(const aString: AnsiString; aCharCount: Integer; aChar: AnsiChar): AnsiString;
var
PadCount: Integer;
begin
PadCount := ACharCount - Length(AString);
if PadCount > 0 then begin
SetLength(Result, ACharCount);
FillChar(Result[1], PadCount, AChar);
Move(AString[1], Result[PadCount + 1], Length(AString));
end else
Result := AString;
end;
I don't know whether Delphi 2009 and later provide a double-byte Char-based equivalent of FillChar, and if they do, I don't know what it's called, so I have changed the signature of the function to explicitly use AnsiString. If you need WideString or UnicodeString, you'll have to find the FillChar replacement that handles two-byte characters. (FillChar has a confusing name as of Delphi 2009 since it doesn't handle full-sized Char values.)
Another thing to consider is whether you really need to call that function so often in the first place. The fastest code is the code that never runs.
Another thought - if this is Delphi 2009 or 2010, disable "String format checking" in Project, Options, Delphi Compiler, Compiling, Code Generation.
StringOfChar is very fast and I doubt you can improve this code a lot. Still, try this one, maybe it's faster:
function cwLeftPad(aString:string; aCharCount:integer; aChar:char): string;
var
i,vLength:integer;
origSize: integer;
begin
Result := aString;
origSize := Length(Result);
if aCharCount <= origSize then
Exit;
SetLength(Result, aCharCount);
Move(Result[1], Result[aCharCount-origSize+1], origSize * SizeOf(char));
for i := 1 to aCharCount - origSize do
Result[i] := aChar;
end;
EDIT: I did some testing and my function is slower than your improved cwLeftPad. But I found something else - there's no way your CPU needs 5 seconds to execute 35k cwLeftPad functions except if you're running on PC XT or formatting gigabyte strings.
I tested with this simple code
for i := 1 to 35000 do begin
a := 'abcd1234';
b := cwLeftPad(a, 73, '.');
end;
and I got 255 milliseconds for your original cwLeftPad, 8 milliseconds for your improved cwLeftPad and 16 milliseconds for my version.
You call StringOfChar every time now. Of course this method checks if it has something to do and jumps out if length is small enough, but maybe the call to StringOfChar is time consuming, because internally it does another call before jumping out.
So my first idea would be to jump out by myself if there is nothing to do:
function cwLeftPad(const aString: string; aCharCount: Integer; aChar: Char;): string;
var
l_restLength: Integer;
begin
Result := aString;
l_restLength := aCharCount - Length(aString);
if (l_restLength < 1) then
exit;
Result := StringOfChar(aChar, l_restLength) + aString;
end;
You can speed up this routine even more by using lookup array.
Of course it depends on your requirements. If you don't mind wasting some memory...
I guess that the function is called 35 k times but it has not 35000 different padding lengths and many different chars.
So if you know (or you are able to estimate in some quick way) the range of paddings and the padding chars you could build an two-dimensional array which include those parameters.
For the sake of simplicity I assume that you have 10 different padding lengths and you are padding with one character - '.', so in example it will be one-dimensional array.
You implement it like this:
type
TPaddingArray = array of String;
var
PaddingArray: TPaddingArray;
TestString: String;
function cwLeftPad4(const aString:string; const aCharCount:integer; const aChar:char; var anArray: TPaddingArray ): string;
begin
Result := anArray[aCharCount-length(aString)] + aString;
end;
begin
//fill up the array
SetLength(StrArray, 10);
PaddingArray[0] := '';
PaddingArray[1] := '.';
PaddingArray[2] := '..';
PaddingArray[3] := '...';
PaddingArray[4] := '....';
PaddingArray[5] := '.....';
PaddingArray[6] := '......';
PaddingArray[7] := '.......';
PaddingArray[8] := '........';
PaddingArray[9] := '.........';
//and you call it..
TestString := cwLeftPad4('Some string', 20, '.', PaddingArray);
end;
Here are benchmark results:
Time1 - oryginal cwLeftPad : 27,0043604142394 ms.
Time2 - your modyfication cwLeftPad : 9,25971967336897 ms.
Time3 - Rob Kennedy's version : 7,64538131122457 ms.
Time4 - cwLeftPad4 : 6,6417059620664 ms.
Updated benchmarks:
Time1 - oryginal cwLeftPad : 26,8360194218451 ms.
Time2 - your modyfication cwLeftPad : 9,69653117046119 ms.
Time3 - Rob Kennedy's version : 7,71149259179622 ms.
Time4 - cwLeftPad4 : 6,58248533610693 ms.
Time5 - JosephStyons's version : 8,76641780969192 ms.
The question is: is it worth the hassle?;-)
It's possible that it may be quicker to use StringOfChar to allocate an entirely new string the length of string and padding and then use move to copy the existing text over the back of it.
My thinking is that you create two new strings above (one with FillChar and one with the plus). This requires two memory allocates and constructions of the string pseudo-object. This will be slow. It may be quicker to waste a few CPU cycles doing some redundant filling to avoid the extra memory operations.
It may be even quicker if you allocated the memory space then did a FillChar and a Move, but the extra fn call may slow that down.
These things are often trial-and-error!
You can get dramatically better performance if you pre-allocate the string.
function cwLeftPadMine
{$IFDEF VER210} //delphi 2010
(aString: ansistring; aCharCount: integer; aChar: ansichar): ansistring;
{$ELSE}
(aString: string; aCharCount: integer; aChar: char): string;
{$ENDIF}
var
i,n,padCount: integer;
begin
padCount := aCharCount - Length(aString);
if padCount > 0 then begin
//go ahead and set Result to what it's final length will be
SetLength(Result,aCharCount);
//pre-fill with our pad character
FillChar(Result[1],aCharCount,aChar);
//begin after the padding should stop, and restore the original to the end
n := 1;
for i := padCount+1 to aCharCount do begin
Result[i] := aString[n];
end;
end
else begin
Result := aString;
end;
end;
And here is a template that is useful for doing comparisons:
procedure TForm1.btnPadTestClick(Sender: TObject);
const
c_EvalCount = 5000; //how many times will we run the test?
c_PadHowMany = 1000; //how many characters will we pad
c_PadChar = 'x'; //what is our pad character?
var
startTime, endTime, freq: Int64;
i: integer;
secondsTaken: double;
padIt: string;
begin
//store the input locally
padIt := edtPadInput.Text;
//display the results on the screen for reference
//(but we aren't testing performance, yet)
edtPadOutput.Text := cwLeftPad(padIt,c_PadHowMany,c_PadChar);
//get the frequency interval of the OS timer
QueryPerformanceFrequency(freq);
//get the time before our test begins
QueryPerformanceCounter(startTime);
//repeat the test as many times as we like
for i := 0 to c_EvalCount - 1 do begin
cwLeftPad(padIt,c_PadHowMany,c_PadChar);
end;
//get the time after the tests are done
QueryPerformanceCounter(endTime);
//translate internal time to # of seconds and display evals / second
secondsTaken := (endTime - startTime) / freq;
if secondsTaken > 0 then begin
ShowMessage('Eval/sec = ' + FormatFloat('#,###,###,###,##0',
(c_EvalCount/secondsTaken)));
end
else begin
ShowMessage('No time has passed');
end;
end;
Using that benchmark template, I get the following results:
The original: 5,000 / second
Your first revision: 2.4 million / second
My version: 3.9 million / second
Rob Kennedy's version: 3.9 million / second
This is my solution. I use StringOfChar instead of FillChar because it can handle unicode strings/characters:
function PadLeft(const Str: string; Ch: Char; Count: Integer): string;
begin
if Length(Str) < Count then
begin
Result := StringOfChar(Ch, Count);
Move(Str[1], Result[Count - Length(Str) + 1], Length(Str) * SizeOf(Char));
end
else Result := Str;
end;
function PadRight(const Str: string; Ch: Char; Count: Integer): string;
begin
if Length(Str) < Count then
begin
Result := StringOfChar(Ch, Count);
Move(Str[1], Result[1], Length(Str) * SizeOf(Char));
end
else Result := Str;
end;
It's a bit faster if you store the length of the original string in a variable:
function PadLeft(const Str: string; Ch: Char; Count: Integer): string;
var
Len: Integer;
begin
Len := Length(Str);
if Len < Count then
begin
Result := StringOfChar(Ch, Count);
Move(Str[1], Result[Count - Len + 1], Len * SizeOf(Char));
end
else Result := Str;
end;
function PadRight(const Str: string; Ch: Char; Count: Integer): string;
var
Len: Integer;
begin
Len := Length(Str);
if Len < Count then
begin
Result := StringOfChar(Ch, Count);
Move(Str[1], Result[1], Len * SizeOf(Char));
end
else Result := Str;
end;