Re: [fpc-pascal] Sample unit code
On Saturday 04 April 2009 11:40:03 Francisco Reyes wrote:
>
> I guess I could try one unit at a time until I find a simple one, but I
> figure if anyone knows of a simple unit that may be easy to read, that may
> be a better starting point.
Here's a simple unit that may help. I have occasion to add time values in my
programs. I don't care that 249 seconds isn't "proper time" and in the form
of 4 minutes and 9 seconds, I just want it encoded into a TDateTime value so
I can add it to another TDateTime value.
Save this as my_unit.pp:
unit my_unit;
interface
{ Everything out here in the interface section is seen by programs
that use this unit }
function EncodeTimeValue (hr, min, sec, msec: Integer): TDateTime;
implementation
{ Everything down here is hidden to the outside }
const
HoursPerDay = 24;
MinutesPerDay = 60 * HoursPerDay;
SecondsPerDay = 60 * MinutesPerDay;
MilliSecsPerDay = 1000 * SecondsPerDay;
function EncodeTimeValue (hr, min, sec, msec: Integer): TDateTime;
begin
Result := hr / HoursPerDay +
min / MinutesPerDay +
sec / SecondsPerDay +
msec / MilliSecsPerDay;
end;
end.
There you go, one complete unit. In a main program (or even in another unit),
all you have to do is use that unit and you can then call the function all
you want:
program test_my_unit;
uses
my_unit;
begin
Writeln ('24 hours and 720 minutes is 1.5 days: ',
EncodeTimeValue (24, 720, 0, 0));
{ Uncomment this next to see an error, because HoursPerDay is private }
{ Writeln ('Hours per day is: ', HoursPerDay); }
end.
To add a new routine, put it down in the implementation section, and copy
the 'procedure foo(blahblah)' or 'function bar(blahblah): blah' part up to
the interface section.
There are also 'initialization' and 'finalization' sections too, but you can
probably ignore those until you understand units better.
I hope this is helpful. The code above is released to the public domain, if
anyone cares to use it.
Best regards,
Pete C.
--
=
Cliches are a dime a dozen; that's why I avoid them like the plague.
=
___
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
Re: [fpc-pascal] Re: fstat usage
On Monday 08 December 2008 10:22:25 Francisco Reyes wrote: > Francisco Reyes writes: > > Trying the fstat function and don't seem to be getting the right values > > for ctime, mtime and atime. Those values are Unix timestamp values. You need to convert them into TDateTime values. Look for UnixToDateTime and DateTimeToUnix in DateUtils. Best regards, Pete C. ___ fpc-pascal maillist - fpc-pascal@lists.freepascal.org http://lists.freepascal.org/mailman/listinfo/fpc-pascal
Re: [fpc-pascal] Windows unit and SyncObjs unit clash
On Wednesday 26 March 2008 08:51:53 Graeme Geldenhuys wrote: > On 26/03/2008, Marco van de Voort <[EMAIL PROTECTED]> wrote: > > Hmm, didn't older (<6) versions simply have this, and did synobjs get > > introduced later? In that case, if Delphi can break compat, so can we. > > I think I still have my copy of Delphi 5 lying around. If I can find > it, I'll see if TCriticalSection is in that Windows unit and if > SyncObjs unit existed in v5. Hi, Graeme. I've got D5 installed under Wine here, and the only thing found when grepping for tcriticalsection in the ./Source/Rtl/Win directory is the function "SetCriticalSectionSpinCount". The SyncObjs unit does exist in D5. ~/.wine/drive_c/Program Files/Borland/Delphi5 $ find . -iname 'syncobj*' ./Lib/Debug/syncobjs.dcu ./Lib/syncobjs.dcu ./Source/Vcl/syncobjs.pas Best regards, Pete C. ___ fpc-pascal maillist - fpc-pascal@lists.freepascal.org http://lists.freepascal.org/mailman/listinfo/fpc-pascal
Re: [fpc-pascal] unit system; Â procedure move();
On Monday 17 March 2008 06:40:51 Jonas Maebe wrote: > On 17 Mar 2008, at 12:34, [EMAIL PROTECTED] wrote: > > Is the use of the move procedure right? The array length is > > Maximum-1. When I > > put this length on value[1], the last entry value[Maximum-1] would > > be deleted > > or would be shifted in an different memory area? > > It would overwrite whatever is placed in memory after the array > (which, in case there is nothing, indeed causes an access violation). > Use this instead: > move(values[0],values[1],(Maximum-1)*sizeof(single)); > values[0]:=sameothervalue; Wouldn't it be better to use the length function on the array? Or does that not work in some compiler modes? move(values[0], values[1], (length(values)-1) * sizeof(single)); If the size of the array is ever changed, no code change is required. Best regards, Pete C. ___ fpc-pascal maillist - fpc-pascal@lists.freepascal.org http://lists.freepascal.org/mailman/listinfo/fpc-pascal
Re: [fpc-pascal] syscalls and fpc
On Saturday 16 February 2008 14:55:24 ik wrote: > On Feb 16, 2008 10:03 PM, Florian Klaempfl <[EMAIL PROTECTED]> wrote: > > ik schrieb: > > > 1. There is a support only for up to 6 parameters (plus the instruction > > > itself). > > > > Which syscall has more parameters? > > I don't know, but then again, up until now I did not require to use > syscall on my own (at least using FPC, because I used "write" using > "pure" assembly). But now that I do require, I found a design that I > find it problematic. But as I understand, I'm the only one that think > there is a problem, so I'll give up and I'll not bother you on this > again. If the way the syscall routine works is a problem for you, then you are going to have to take that up with the Linux kernel guys. Free Pascal is only interfacing to something that the Linux kernel provides, and it's provided by the kernel in that very strict, very rigid manner. It doesn't matter what language you use, Pascal, C, or whatever, to perform a system call you must put some integer values into processor registers and perform an interrupt (if I recall correctly without looking it up, int $80). There's no getting around how that works. I beg your pardon if I'm misunderstanding the complaint. Best regards, Pete C. ___ fpc-pascal maillist - fpc-pascal@lists.freepascal.org http://lists.freepascal.org/mailman/listinfo/fpc-pascal
Re: [fpc-pascal] PASCAL programming for Novice
On Saturday 09 June 2007 18:46:17 Francisco Reyes wrote:
> Daniël Mantione writes:
> > It doesn't look for .p by default. Rename to .pas or .pp.
>
> Ok thanks.
> Using .p because that is what vim checks for. Will figure out how to change
> vim to look for .pp for the coloring.
Contents of $HOME/.vim/filetype.vim:
" my filetype file
if exists("did_load_filetypes")
finish
endif
augroup filetypedetect
au! BufRead,BufNewFile *.pp setfiletype pascal
augroup END
Best regards,
Pete C.
___
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
Re: [fpc-pascal] FPC only 32 bits?
On Wednesday 06 June 2007 18:26:15 Francisco Reyes wrote: > Henry Vermaak writes: > > also make sure that the compiler can find > > your binutils (put it on the path). > > I don't see a directory by that name. Is the directory called something > other than binutils? I don't think I can help with the rest of your cross-compiling adventure, but maybe I can help with an brief explanation of binutils. The binutils package is the set of GNU "binary utilities". This includes the assembler (as), linker (ld) and other utilities for working with binary program files. In order to make files that will run on 64 bit freebsd, you'll want to find (or build) a binutils package that works with binaries for 64 bit freebsd. I hope this is helpful. Best regards, Pete C. ___ fpc-pascal maillist - fpc-pascal@lists.freepascal.org http://lists.freepascal.org/mailman/listinfo/fpc-pascal
Re: [fpc-pascal] How to get UTC time
On Tuesday 13 February 2007 14:25, Marco van de Voort wrote:
> > for me. It needs both the SysUtils and Libc units, which I'm already
> > using for other declarations anyway.
>
> Libc is a legacy unit, better use the proper (portable) units, and you'll
> spare yourself a libc dependancy, AND make it portable across unices:
However, to compile in Kylix as well (which I believe my post stated I need)
then there would have to be a bunch of ifdefs spread around since the 'unix'
and 'baseunix' units don't exist there (and consequently, there is no
fpGetTimeOfDay function). Also, since the original questioner wanted it to
work under Windows, there would be even more ifdefs. It makes me glad that
I only have to deal with Kylix and FPC under Linux. :)
To answer that "how to do this under Windows" part of the original question,
it looks like it's just as easy. The GetSystemTime API routine returns the
current date and time in UTC form. There's a function in SysUtils to convert
the TSystemTime into a TDateTime, so the following should work. I only
tested it in Delphi 5 under Wine, because that's all I have on this system
for such things:
{$ifdef MSWINDOWS}
{ This uses SysUtils and Windows. }
function emt_now: TDateTime;
var
st: TSystemTime;
begin
GetSystemTime (st);
Result := SystemTimeToDateTime (st);
end;
{$endif}
Adding this to the previous bit of code, and properly supporting compilation
with FPC under *nix and Windows, as well as Delphi and Kylix, is left as an
exercise for the interested reader. ;-)
Best regards,
Pete C.
___
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
Re: [fpc-pascal] How to get UTC time
On Tuesday 13 February 2007 03:37, Michel Meunier wrote:
> I work on a program wich need the UTC time, and this program will run
> with Windows and Linux.
> So how is it possible to calculate the UTC time under these two OS.
Hello, Michel.
I do not program under Windows, so I cannot answer that part of the question,
but getting the UTC time under Linux is quite easy. I have written a utc_now
function which I use under both Kylix and Free Pascal. If you can find the
answer for Windows, then it should be easy enough to combine the two into one
function with an {$ifdef }.
There may be (and there probably are) better ways of doing it, but this works
for me. It needs both the SysUtils and Libc units, which I'm already using
for other declarations anyway.
//
// Routine: utc_now
//
// Purpose: Returns the current UTC time as a TDateTime value.
//
function utc_now : TDateTime;
var
timeval: TTimeVal;
timezone: PTimeZone;
a: Double;
begin
TimeZone := nil;
GetTimeOfDay (TimeVal, TimeZone);
// Convert to milliseconds
a := (TimeVal.tv_sec * 1000.0) + (TimeVal.tv_usec / 1000.0);
Result := (a / MSecsPerDay) + UnixDateDelta;
end;
I hope this helps,
Pete C.
___
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
Re: [fpc-pascal] [SYSTEM]: How detecting if run as root ?
On Wednesday 11 October 2006 20:44, Michalis Kamburelis wrote: > Pete Cervasio wrote: > > The better way would be to use the geteuid function in the libc unit, > > It would be even better to use FpGetEUid function from the BaseUnix > unit. See > [http://www.freepascal.org/docs-html/rtl/baseunix/fpgeteuid.html]. DOH! Thanks for reminding me, Michalis. I always forget about seeing if a function is already in the RTL when doing things that I know are standard C library functions. Force of habit is my (bad) excuse. :) Best regards, Pete C. ___ fpc-pascal maillist - fpc-pascal@lists.freepascal.org http://lists.freepascal.org/mailman/listinfo/fpc-pascal
Re: [fpc-pascal] [SYSTEM]: How detecting if run as root ?
On Wednesday 11 October 2006 19:37, Andrew Haines wrote:
> TOUZEAU DAVID wrote:
> > Dear
> >
> > I need to detect if the program is executed as root privileges on Linux
> > system.
> > Did somebody had developped a such function ??
> >
> > Best regards.
>
> Well you can try GetEnv('USER') = 'root'; or GetEnv('UID') = '0'; but
> there may be better ways to check this.
The better way would be to use the geteuid function in the libc unit, because
the environment variables may not be set (such as if they were explictly
unset or if the program is run from cron or the system startup scripts).
See the getuid/geteuid man page for particulars. And no, I am not saying
"RTFMP" spitefully. :) :)
Best regards,
Pete C.
___
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
Re: [fpc-pascal] Re: Threads executing in sequence instead of parallel
On Friday 29 September 2006 04:57, Graeme Geldenhuys wrote:
>
> Below is a text (console) thread demo. The one thread counts from 0 to
> 1k and the other thread counts down from 1k to 0. Again, under Linux,
> one thread executes and teminates, then the next thread executes and
> terminates.
Greetings, Graeme.
I think I see the problem. On today's fast machines, a count of 1000 just
isn't enough processing for a meaningful test, at least not under Linux. I
really don't know much about Windows, but my conjecture is that perhaps under
that system the function calls to write the output cause the other thread to
receive processing time.
The following modified version of your program shows that threads work under
Linux. The execute loops have been modified to continually count up/down (as
appropriate) until terminated. The RunNow procedure was modified to let the
threads run for three seconds before terminating them itself, and the
FThreadCount thing was taken out (along with the OnTerminate handlers).
To properly see the output, you should redirect it to a file, unless you
really have a LOT of scrollback buffer set up. :-) On my Athlon XP 2200 I
get a file 35.5 megabytes in size!
~/tmp $./demo1 > demo1.txt
~/tmp $ls -l demo1.txt
-rw-r--r-- 1 pcervasio users 39566886 2006-10-02 12:31 demo1.txt
After looking at the contents of demo1.txt, I can see that the increment
thread actually got to its eleventh count up before the decrement thread got
its first share of time. This should help explain why in your original
program it appeared that one thread was executing to completion before the
other... it WAS, but only because there wasn't enough to do.
The above was done using version 2.04 of the compiler on a Slackware 10.1
machine with a 2.4.32 kernel. I appear to get similar results on my 2.6.17.6
box after copying the executable over (running an Athlon 2600). The
decrementor first shows up after incrementor loop 15. The redirected output
file is 53 megabytes, though... much bigger than I expected from the machine
speed difference alone.
I hope this is helpful.
Best regards,
Pete C.
---
program demo1a;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}
{$IFDEF UseCThreads}
cthreads,
{$ENDIF}
{$ENDIF}
Classes, SysUtils;
type
// counts up till 1k until terminated
TIncrementer = class(TThread)
protected
procedure Execute; override;
end;
// counts down from 1k until terminated
TDecrementer = class(TThread)
protected
procedure Execute; override;
end;
TRunThreads = class(TObject)
private
t1, t2: TThread;
public
constructor Create;
procedure RunNow;
end;
{ TRunThreads }
constructor TRunThreads.Create;
begin
t1 := TIncrementer.Create(True);
t1.Priority := tpLower;
t1.FreeOnTerminate := True;
t2 := TDecrementer.Create(True);
t2.Priority := tpLower;
t2.FreeOnTerminate := True;
end;
procedure TRunThreads.RunNow;
var
donetime: TDateTime;
begin
{ run for 3 seconds }
donetime := now + encodetime(0, 0, 3, 0);
writeln('RunNow');
t1.Resume;
t2.Resume;
repeat
sleep (100);
until now > donetime;
t1.terminate;
t2.terminate;
sleep (10); { give threads a chance to end }
WriteLn('All threads completed!');
end;
{ TIncrementer }
procedure TIncrementer.Execute;
var
i, j: integer;
begin
j := 0;
while not terminated do
begin
writeln (ClassName, ': --- Loop ', j);
for i := 0 to 1000 do
begin
if terminated then break;
Writeln(Classname, ': ', i);
end;
end;
end;
{ TDecrementer }
procedure TDecrementer.Execute;
var
i, j: integer;
begin
j := 0;
while not terminated do
begin
writeln (ClassName, ': --- Loop ', j);
for i := 1000 downto 0 do
begin
if terminated then break;
Writeln(Classname, ': ', i);
end;
end;
end;
var
lRunThreads: TRunThreads;
begin
lRunThreads := TRunThreads.Create;
lRunThreads.RunNow;
writeln('Done...');
end.
---
___
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
