Re: [fpc-pascal] Sample unit code

2009-04-04 Thread Pete Cervasio
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

2008-12-08 Thread Pete Cervasio
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

2008-03-26 Thread Pete Cervasio
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();

2008-03-17 Thread Pete Cervasio
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

2008-02-16 Thread Pete Cervasio
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

2007-06-09 Thread Pete Cervasio
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?

2007-06-06 Thread Pete Cervasio
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

2007-02-13 Thread Pete Cervasio
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] How to get UTC time

2007-02-13 Thread Pete Cervasio
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] [SYSTEM]: How detecting if run as root ?

2006-10-11 Thread Pete Cervasio
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] [SYSTEM]: How detecting if run as root ?

2006-10-11 Thread Pete Cervasio
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] Re: Threads executing in sequence instead of parallel

2006-10-02 Thread Pete Cervasio
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