+ Initial implementation; Donated by Gertjan Schouten

  His file was split into several files, to keep it a little bit structured.

rtl/objpas/dati.inc

@@ -0,0 +1,309 @@
+{
+    *********************************************************************
+    $Id$
+    Copyright (C) 1997, 1998 Gertjan Schouten
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+    *********************************************************************
+
+    System Utilities For Free Pascal
+}
+
+{ date time functions }
+
+function IsLeapYear(Year: Word): Boolean;
+begin
+IsLeapYear := (Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0));
+end;
+
+function DoEncodeDate(Year, Month, Day: Word):longint;
+var
+   I: Longint;
+begin
+DoEncodeDate := 0;
+if (Year >= 1) and (Year <= 9999) and (Month >= 1) and (Month <= 12) and
+   (Day >= 1) and (Day <= 31) then begin
+   Day := Day + DayTable[IsLeapYear(Year), Month] - 1;
+   I := Year - 1;
+   DoEncodeDate := I * 365 + I div 4 - I div 100 + I div 400 + Day;
+   end ;
+end ;
+
+function  doEncodeTime(Hour,Minute,Second,MilliSecond:word):longint;
+begin
+doEncodeTime := (Hour * 3600000 + Minute * 60000 + Second * 1000 + MilliSecond) { div MSecsPerDay} ;
+end ;
+
+function  DateToStr(Date:TDateTime):string;
+begin
+DateToStr := FormatDateTime('c', Date);
+end ;
+
+function  TimeToStr(Time:TDateTime):string;
+begin
+TimeToStr := FormatDateTime('t', Time);
+end ;
+
+function  DateTimeToStr(DateTime:TDateTime):string;
+begin
+DateTimeToStr := FormatDateTime('c t', DateTime);
+end ;
+
+function  EncodeDate(Year, Month, Day :word):TDateTime;
+begin
+EncodeDate := DoEncodeDate(Year, Month, Day);
+end ;
+
+function  EncodeTime(Hour, Minute, Second, MilliSecond:word):TDateTime;
+begin
+EncodeTime := doEncodeTime(hour, minute, second, millisecond) / MSecsPerDay;
+end ;
+
+procedure DecodeDate(Date:TDateTime;var Year:word;var Month:word;var Day:word);
+const
+   D1 = 365;            { number of days in 1 year }
+   D4 = D1 * 4 + 1;     { number of days in 4 years }
+   D100 = D4 * 25 - 1;  { number of days in 100 years }
+   D400 = D100 * 4 + 1; { number of days in 400 years }
+var
+   i:Longint;
+   l:longint;
+   ly:boolean;
+begin
+l := Trunc(Int(Date));
+year := 1 + 400 * (l div D400); l := (l mod D400);
+year := year + 100 * (l div D100);l := (l mod D100);
+year := year + 4 * (l div D4);l := (l mod D4);
+year := year + (l div D1);l := 1 + (l mod D1);
+month := 0;
+ly := IsLeapYear(Year);
+while (month < 12) and (l > DayTable[ly, month + 1]) do
+   inc(month);
+day := l - DayTable[ly, month];
+end ;
+
+procedure DecodeTime(Time:TDateTime;var Hour:word;var Minute:word;var Second:word;var MilliSecond:word);
+var l:longint;
+begin
+l := Trunc(Frac(time) * MSecsPerDay);
+Hour   := l div 3600000;l := l mod 3600000;
+Minute := l div 60000;l := l mod 60000;
+Second := l div 1000;l := l mod 1000;
+MilliSecond := l;
+end ;
+
+function  FormatDateTime(formatstr:string;DateTime:TDateTime):string;
+var i:longint;result:string;current:string;e:longint;
+    y,m,d,h,n,s,ms:word;
+    mDate, mTime:double;
+begin
+mDate := int(DateTime);
+mTime := frac(DateTime);
+DecodeDate(mDate, y, m, d);
+DecodeTime(mTime, h, n, s, ms);
+result := '';
+current := '';
+i := 1;
+e := 0;
+while not(i > length(formatstr)) do begin
+   while not(formatstr[i] in [' ','"','/',':','''']) and not(i > length(formatstr)) do begin
+      current := current + formatstr[i];
+      inc(i);
+      end ;
+   if ((current = 'a') or (current = 'am')) and (formatstr[i] = '/') then begin
+      inc(i);current := current + '/';
+      while not(formatstr[i] in [' ','"','/',':','''']) and not(i > length(formatstr)) do begin
+         current := current + formatstr[i];
+         inc(i);
+         end ;
+      end ;
+   if not(current = '') then begin
+      if (current = 'c') then begin
+         i := 1; result := ''; current := '';
+         formatstr := ' ' + shortdateformat + '" "' + shorttimeformat;
+         end ;
+      if not(mTime = 0) then begin
+         if (current = 't') then begin
+            formatstr := ' ' + shorttimeformat + copy(formatstr, i, length(formatstr));
+            i := 1;
+            end
+         else if (current = 'tt') then begin
+            formatstr := ' ' + longtimeformat + copy(formatstr,i,length(formatstr));
+            i := 1;
+            end
+         else if (current = 'h') then result := result + inttostr(h)
+         else if (current = 'hh') then result := result + right('0'+inttostr(h),2)
+         else if (current = 'n') then result := result + inttostr(n)
+         else if (current = 'nn') then result := result + right('0'+inttostr(n),2)
+         else if (current = 's') then result := result + inttostr(s)
+         else if (current = 'ss') then result := result + right('0'+inttostr(s),2)
+         else if (current = 'am/pm') then begin
+      	   if (h < 13) then result := result + 'am'
+            else result := result + 'pm';
+			   end
+         else if (current = 'a/p') then begin
+      	   if h < 13 then result := result + 'a'
+            else result := result + 'p';
+      	   end
+         else if (current = 'ampm') then begin
+            if h < 13 then strCat(result, TimeAMString)
+            else strCat(result, TimePMString);
+            end ;
+         end ;
+      if not(mDate = 0) then begin
+         if (current = 'd') then result := result + inttostr(d)
+         else if (current = 'dd') then result := result + right('0' + inttostr(d), 2)
+         else if (current = 'ddd') then StrCat(result, shortdaynames[DayOfWeek(DateTime)])
+         else if (current = 'dddd') then StrCat(result, longdaynames[DayOfWeek(DateTime)])
+         else if (current = 'm') then result := result + inttostr(m)
+         else if (current = 'mm') then result := result + right('0' + inttostr(m), 2)
+         else if (current = 'mmm') then StrCat(result, shortmonthnames[m])
+         else if (current = 'mmmm') then StrCat(result, longmonthnames[m])
+         else if (current = 'y') then result := result + inttostr(y)
+         else if (current = 'yy') then result := result + right(inttostr(y), 2)
+         else if (current = 'yyyy') or (current = 'yyy') then result := result + inttostr(y);
+         end ;
+      current := '';
+      end ;
+   if (formatstr[i] = '/') and not(mDate = 0) then result := result + dateseparator
+   else if (formatstr[i] = ':') and not(mTime = 0) then result := result + timeseparator
+   else if (formatstr[i] in ['"','''']) then begin
+      inc(i);
+      while not(formatstr[i] in ['"','''']) and not(i > length(formatstr)) do begin
+         result := result + formatstr[i];
+         inc(i);
+         end ;
+      end ;
+   inc(i);
+   end ;
+FormatDateTime := Result;
+end ;
+
+function  StrToDate(const s:string):TDateTime;
+var
+   df:string;
+   d,m,y:word;n,i:longint;c:word;
+   s1:string[4];
+   values:array[0..2] of longint;
+   LocalTime:tsystemtime;
+begin
+df := UpperCase(ShortDateFormat);
+d := 0;m := 0;y := 0;
+for i := 0 to 2 do values[i] := 0;
+s1 := '';
+n := 0;
+for i := 1 to length(s) do begin
+   if (s[i] in ['0'..'9']) then s1 := s1 + s[i];
+   if (s[i] in [dateseparator,' ']) or (i = length(s)) then begin
+      val(s1, values[n], c);
+      s1 := '';
+      inc(n);
+      end ;
+   end ;
+if (df = 'D/M/Y') then begin
+   d := values[0];
+   m := values[1];
+   y := values[2];
+   end
+else if (df = 'M/D/Y') then begin
+   if (n > 1) then begin
+      m := values[0];
+      d := values[1];
+      y := values[2];
+      end
+   else { if there is just one value, it is the day of the month }
+      d := values[0];
+   end
+else if (df = 'Y/M/D') then begin
+   if (n = 3) then begin
+      y := values[0];
+   	m := values[1];
+      d := values[2];
+      end
+   else if (n = 2) then begin
+      m := values[0];
+      d := values[1];
+      end
+   else if (n = 1) then
+      d := values[0];
+   end ;
+if (n < 3) then begin
+   getLocalTime(LocalTime);
+   y := LocalTime.wYear;
+   if (n < 2) then
+      m := LocalTime.wMonth;
+   end ;
+if (y >= 0) and (y < 100) then y := 1900 + y;
+StrToDate := DoEncodeDate(y, m, d);
+end ;
+
+function  StrToTime(const s:string):TDateTime;
+begin
+end ;
+
+function  StrToDateTime(const s:string):TDateTime;
+begin
+end ;
+
+function  DayOfWeek(DateTime:TDateTime):longint;
+begin
+DayOfWeek := (1 + Trunc(DateTime)) mod 7;
+end ;
+
+procedure getlocaltime(var systemtime:tsystemtime);
+var wDayOfWeek:word;
+begin
+getdate(systemtime.wYear,
+  		  systemtime.wMonth,
+        systemtime.wDay,
+        wDayOfWeek);
+gettime(systemtime.whour,
+        systemtime.wminute,
+		  systemtime.wsecond,
+		  systemtime.wmillisecond);
+systemtime.wmillisecond := systemtime.wmillisecond * 10;
+end ;
+
+function  Date:TDateTime;
+var systemtime:tsystemtime;
+begin
+getlocaltime(systemtime);
+date := doEncodeDate(systemtime.wYear,systemtime.wMonth,systemtime.wDay);
+end ;
+
+function  Time:TDateTime;
+var systemtime:tsystemtime;
+begin
+getlocaltime(systemtime);
+time := doEncodeTime(systemtime.wHour,systemtime.wMinute,
+                   systemtime.wSecond,systemtime.wMillisecond) / MSecsPerDay;
+end ;
+
+function  Now:TDateTime;
+var systemtime:tsystemtime;
+begin
+getlocaltime(systemtime);
+now := doEncodeDate(systemtime.wYear,systemtime.wMonth,systemtime.wDay) +
+       doEncodeTime(systemtime.wHour,systemtime.wMinute,
+                    systemtime.wSecond,systemtime.wMillisecond) / MSecsPerDay;
+end ;
+
+{
+  $Log$
+  Revision 1.1  1998-04-10 15:17:46  michael
+  + Initial implementation; Donated by Gertjan Schouten
+    His file was split into several files, to keep it a little bit structured.
+
+}

rtl/objpas/datih.inc

@@ -0,0 +1,119 @@
+{
+    *********************************************************************
+    $Id$
+    Copyright (C) 1997, 1998 Gertjan Schouten
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+    *********************************************************************
+
+    System Utilities For Free Pascal
+}
+
+
+const
+   SecsPerDay = 24 * 60 * 60; // Seconds and milliseconds per day
+   MSecsPerDay = SecsPerDay * 1000;
+
+   DateDelta = 693594; // Days between 1/1/0001 and 12/31/1899
+   DateSeparator:char='-';
+   TimeSeparator:char=':';
+   TimeAMString: pchar = 'am';
+   TimePMString: pchar = 'pm';
+   ShortMonthNames: array[1..12] of pchar =
+     ('jan','feb','mar','apr','mai','jun',
+      'jul','aug','sep','oct','nov','dec');
+   LongMonthNames: array[1..12] of pchar=
+     ('january','february','march','april','mai','june',
+      'july','august','september','october','november','december');
+   ShortDayNames: array[1..7] of pchar=
+     ('sun','mon','tue','wen','thu','fri','sat');
+   LongDayNames: array[1..7] of pchar=
+     ('sunday','monday','tuesday','wednesday','thursday','friday','saturday');
+
+   {  date time formatting characters:
+      c      : shortdateformat + ' ' + shorttimeformat
+      d      : day of month
+      dd     : day of month (leading zero)
+      ddd    : day of week (abbreviation)
+      dddd   : day of week (full)
+      ddddd  : shortdateformat
+      dddddd : longdateformat
+      m      : month
+      mm     : month (leading zero)
+      mmm    : month (abbreviation)
+      mmmm   : month (full)
+      y      : year (four digits)
+      yy     : year (two digits)
+      yyyy   : year (with century)
+      h      : hour
+      hh     : hour (leading zero)
+      n      : minute
+      nn     : minute (leading zero)
+      s      : second
+      ss     : second (leading zero)
+      t      : shorttimeformat
+      tt     : longtimeformat
+      am/pm  : use 12 hour clock and display am and pm accordingly
+		a/p    : use 12 hour clock and display a and p accordingly
+      /      : insert date seperator
+      :      : insert time seperator
+      "xx"   : literal text
+      'xx'   : literal text
+   }
+
+// these constant strings will be changed to pchars too, someday :)
+   ShortDateFormat:string='d/m/y';
+   LongDateFormat:string='dd" "mmmm" "yyyy';
+   ShortTimeFormat:string='hh:nn';
+   LongTimeFormat:string='hh:nn:ss';
+
+   Eoln = #10; // or should that be #13, or $0d0a
+
+type
+   TSystemTime=record
+      wYear:word;wMonth:word;wDay:word;
+      wHour:word;wMinute:word;wSecond:word;wMilliSecond:word;
+   end ;
+   TDateTime = double;
+
+{  Date and Time functions  }
+
+function  DateToStr(Date:TDateTime):string;
+function  TimeToStr(Time:TDateTime):string;
+function  DateTimeToStr(DateTime:TDateTime):string;
+function  EncodeDate(Year, Month, Day :word):TDateTime;
+function  EncodeTime(Hour, Minute, Second, MilliSecond:word):TDateTime;
+procedure DecodeDate(Date:TDateTime;var Year:word;var Month:word;var Day:word);
+procedure DecodeTime(Time:TDateTime;var Hour:word;var Minute:word;var Second:word;var MilliSecond:word);
+function  FormatDateTime(FormatStr:string;DateTime:TDateTime):string;
+function  StrToDate(const s:string):TDateTime;
+function  StrToTime(const s:string):TDateTime;
+function  StrToDateTime(const s:string):TDateTime;
+function  DayOfWeek(DateTime:TDateTime):longint;
+function  Date:TDateTime;
+function  Time:TDateTime;
+function  Now:TDateTime;
+procedure GetLocalTime(var systemtime:tsystemtime);
+
+
+{
+
+  $Log$
+  Revision 1.1  1998-04-10 15:17:46  michael
+  + Initial implementation; Donated by Gertjan Schouten
+    His file was split into several files, to keep it a little bit structured.
+
+
+}

rtl/objpas/fina.inc

@@ -0,0 +1,106 @@
+{
+    *********************************************************************
+    $Id$
+    Copyright (C) 1997, 1998 Gertjan Schouten
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+    *********************************************************************
+
+    System Utilities For Free Pascal
+}
+
+
+type
+   PByte=^Byte;
+   PWord=^Word;
+   PLongint=^Longint;
+
+const
+   DayTable:array[Boolean,1..12] of longint =
+      ((0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334),
+       (0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335));
+   HexDigits: array[0..15] of char = '0123456789ABCDEF';
+
+function ChangeFileExt(FileName, Extension: string): string;
+var i: longint;
+begin
+I := Length(FileName);
+while (I > 0) and not (FileName[I] in ['.', '\', ':']) do Dec(I);
+if (I = 0) or (FileName[I] <> '.') then I := 255;
+ChangeFileExt := Copy(FileName, 1, I - 1) + Extension;
+end;
+
+function ExtractFilePath(FileName: string): string;
+var i: longint;
+begin
+i := Length(FileName);
+while (I > 0) and not (FileName[I] in ['\', ':']) do Dec(I);
+ExtractFilePath := Copy(FileName, 1, I);
+end;
+
+function ExtractFileDir(FileName: string): string;
+var i: longint;
+begin
+I := Length(FileName);
+while (I > 0) and not (FileName[I] in ['\', ':']) do Dec(I);
+if (I > 1) and (FileName[I] = '\') and
+    not (FileName[I - 1] in ['\', ':']) then Dec(I);
+ExtractFileDir := Copy(FileName, 1, I);
+end;
+
+function ExtractFileDrive(FileName: string): string;
+var i, j: longint;
+begin
+if (Length(FileName) >= 3) and (FileName[2] = ':') then
+   ExtractFileDrive := Copy(FileName, 1, 2)
+else if (Length(FileName) >= 2) and (FileName[1] = '\') and
+   (FileName[2] = '\') then begin
+   J := 0;
+   I := 3;
+   While (I < Length(FileName)) and (J < 2) do begin
+      if FileName[I] = '\' then Inc(J);
+      if J < 2 then Inc(I);
+      end;
+   if FileName[I] = '\' then Dec(I);
+   ExtractFileDrive := Copy(FileName, 1, I);
+   end else ExtractFileDrive := '';
+end;
+
+function ExtractFileName(FileName: string): string;
+var i: longint;
+begin
+I := Length(FileName);
+while (I > 0) and not (FileName[I] in ['\', ':']) do Dec(I);
+ExtractFileName := Copy(FileName, I + 1, 255);
+end;
+
+function ExtractFileExt(FileName: string): string;
+var i: longint;
+begin
+I := Length(FileName);
+while (I > 0) and not (FileName[I] in ['.', '\', ':']) do Dec(I);
+if (I > 0) and (FileName[I] = '.') then
+   ExtractFileExt := Copy(FileName, I, 255)
+else ExtractFileExt := '';
+end;
+
+
+{
+  $Log$
+  Revision 1.1  1998-04-10 15:17:46  michael
+  + Initial implementation; Donated by Gertjan Schouten
+    His file was split into several files, to keep it a little bit structured.
+
+}

rtl/objpas/finah.inc

@@ -0,0 +1,38 @@
+{
+    *********************************************************************
+    $Id$
+    Copyright (C) 1997, 1998 Gertjan Schouten
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+    *********************************************************************
+
+    System Utilities For Free Pascal
+}
+
+{ Filename Functions }
+
+function ChangeFileExt(FileName, Extension: string): string;
+function ExtractFilePath(FileName: string): string;
+function ExtractFileDrive(FileName: string): string;
+function ExtractFileName(FileName: string): string;
+function ExtractFileExt(FileName: string): string; { Returns file extension like '.123' }
+
+{
+  $Log$
+  Revision 1.1  1998-04-10 15:17:46  michael
+  + Initial implementation; Donated by Gertjan Schouten
+    His file was split into several files, to keep it a little bit structured.
+
+}

rtl/objpas/syspch.inc

@@ -0,0 +1,288 @@
+{
+    *********************************************************************
+    $Id$
+    Copyright (C) 1997, 1998 Gertjan Schouten
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+    *********************************************************************
+
+    System Utilities For Free Pascal
+}
+
+{  PChar functions  }
+
+function  NewStr(s:string):pchar;
+var p:pchar;l:longint;
+begin
+l := length(s);
+p := StrAlloc(l + 1);
+move(s[1], p^, l);
+byte(pchar(p + l)^) := 0;
+NewStr := p;
+end ;
+
+function  StrAlloc(Size:longint):pchar;
+var p:pointer;
+begin
+Getmem(p, size + sizeof(longint));
+Move(Size, p^, sizeof(longint));
+pbyte(p + sizeof(longint))^ := 0;
+StrAlloc := pchar(p + sizeof(longint));
+end ;
+
+procedure StrDispose(var p:pchar);
+var l:longint;
+begin
+if (p = nil) then exit;
+p := pchar(p - sizeof(longint));
+move(p^, l, sizeof(longint));
+freemem(p, l + sizeof(longint));
+p := nil;
+end ;
+
+function StrPas(p:pchar):string;
+begin
+   asm
+      movl  P,%eax
+      movl  %eax,%esi
+      movl  __RESULT,%eax
+      movl  %eax,%edi
+      pushl %edi
+      incl  %edi
+      xorl  %eax,%eax
+      movw  $255,%cx
+   STR_LOOP1:
+      lodsb
+      orb   %al,%al
+      jz    STR_END
+      stosb
+      loop  STR_LOOP1
+   STR_END:
+      popl  %edi
+      movw  $255,%ax
+      subw  %cx,%ax
+      movb  %al,(%edi)
+   end ;
+end ;
+
+function  StrLen(p:pchar):longint;
+begin
+	asm
+      movl  p,%eax
+      movl  %eax,%esi
+      xorl  %eax,%eax
+      movl  $0xFFFFFFFF,%ecx
+   STRLEN_LOOP:
+      incl  %ecx
+      lodsb
+      orb   %al,%al
+      jnz   STRLEN_LOOP
+      movl  %ecx,__RESULT
+   end ;
+end ;
+
+function  StrEnd(p:pchar):pchar;
+begin
+   asm
+      movl  p,%eax
+      movl  %eax,%esi
+   STREND_LOOP:
+      lodsb
+      orb   %al,%al
+      jnz   STREND_LOOP
+      movl  %esi,__RESULT
+   end ;
+end ;
+
+function  StrMove(Dest, Source: PChar; Count: longint): PChar;
+begin
+   asm
+      movl    source,%eax
+      movl    %eax,%esi
+      movl    dest,%eax
+      movl    %eax,%edi
+      movl    %edi,__RESULT
+      movl    COUNT,%ecx
+      movl    %ecx,%edx
+      cmpl    %esi,%edi
+      jg      STRMOVE_BACK
+      shrl    $2,%ecx
+      rep
+		movsl
+      movl    %edx,%ecx
+      andl    $3,%ecx
+      rep
+		movsb
+      jmp     STRMOVE_END
+   STRMOVE_BACK:
+      addl    %ecx,%edi
+      decl    %edi
+      addl    %ecx,%esi
+      decl    %esi
+      andl    $3,%ecx
+      STD
+      rep
+		movsb
+      subl    $3,%esi
+      subl    $3,%edi
+      movl    %edx,%ecx
+      shrl    $2,%ecx
+      rep
+		movsl
+      CLD
+   STRMOVE_END:
+   end ;
+end ;
+
+function  StrCat(Dest, Source: PChar): PChar;
+begin
+StrCat := Dest;
+while char(dest^) <> #0 do
+   dest := dest + 1;
+while char(source^) <> #0 do begin
+   char(dest^) := char(source^);
+   dest := dest + 1;
+   source := source + 1;
+   end ;
+char(dest^) := #0;
+end ;
+
+function  StrCat(Dest:pchar; Source: string): PChar;
+var l:longint;
+begin
+StrCat := Dest;
+while char(dest^) <> #0 do
+   dest := dest + 1;
+l := length(source);
+move(source[1], dest^, l);
+dest := dest + l;
+char(dest^) := #0;
+end ;
+
+function  StrCat(var Dest:string; Source: pchar): String;
+var count,l:longint;
+begin
+l := length(Dest);
+count := setLength(Dest, l + StrLen(Source)) - l;
+if (count > 0) then
+   move(source^, dest[l + 1], count);
+StrCat := Dest;
+end ;
+
+function  StrIns(Dest:pchar; Source: string): PChar;
+var len:longint;
+begin
+len := length(Source);
+StrMove(dest + len, dest, 1 + strlen(dest));
+Move(Source[1], dest^, len);
+StrIns := dest;
+end ;
+
+function  StrCopy(Dest, Source: PChar): Pchar;
+begin
+   asm
+      movl    Dest,%eax
+      movl    %eax,%edi
+      movl    %eax,__RESULT
+      movl    Source,%eax
+      movl    %eax,%esi
+   STRCOPY_LOOP:
+      lodsb
+      stosb
+      orb     %al,%al
+      jnz     STRCOPY_LOOP
+   end ;
+end ;
+
+function  StrLCopy(Dest, Source: PChar; MaxLen: longint): PChar;
+begin
+   asm
+      movl    Dest,%eax
+      movl    %eax,__RESULT
+      movl    %eax,%edi
+      movl    Source,%eax
+      movl    %eax,%esi
+      movl    MaxLen,%ecx
+      orl     %ecx,%ecx
+      jz      STRLCOPY_END
+   STRLCOPY_LOOP:
+      lodsb
+      orb     %al,%al
+      jz      STRLCOPY_END
+      stosb
+      loop    STRLCOPY_LOOP
+   STRLCOPY_END:
+      xorb    %al,%al
+      stosb
+   end ;
+end ;
+
+function  StrScan(str:pchar;ch:char):pchar;
+begin
+   asm
+      movl    str,%eax
+      movl    %eax,%esi
+      movb    ch,%bl
+   STRSCAN_LOOP:
+      lodsb
+      cmpb    %al,%bl
+      je      STRSCAN_END
+      orb     %al,%al
+      jnz     STRSCAN_LOOP
+   STRSCAN_END:
+      decl    %esi
+      movl    %esi,__RESULT
+   end ;
+end ;
+
+function  StrRScan(str:pchar;ch:char):pchar;
+begin
+   asm
+      movl    str,%eax
+      movl    %eax,%esi
+      movl    %eax,%edx
+      movb    ch,%bl
+   STRRSCAN_LOOP:
+      lodsb
+      cmpb    %al,%bl
+      jne     STRRSCAN_NOTFOUND
+      movl    %esi,%edx
+      decl    %edx
+   STRRSCAN_NOTFOUND:
+      orb     %al,%al
+      jnz     STRRSCAN_LOOP
+      movl    %edx,__RESULT
+   end ;
+end ;
+
+function  StrTer(str:pchar;l:longint):pchar;
+begin
+   asm
+   	movl    str,%eax
+      movl    %eax,__RESULT
+      addl    l,%eax
+      movl    %eax,%edi
+      xorb    %al,%al
+      movb    %al,(%edi)
+   end ;
+end ;
+
+{
+  $Log$
+  Revision 1.1  1998-04-10 15:17:46  michael
+  + Initial implementation; Donated by Gertjan Schouten
+    His file was split into several files, to keep it a little bit structured.
+
+}

rtl/objpas/syspchh.inc

@@ -0,0 +1,49 @@
+{
+    *********************************************************************
+    $Id$
+    Copyright (C) 1997, 1998 Gertjan Schouten
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+    *********************************************************************
+
+    System Utilities For Free Pascal
+}
+
+
+function  NewStr(s:string):pchar;
+function  StrAlloc(Size:longint):pchar;
+procedure StrDispose(var p:pchar);
+function  StrPas(p:pchar):string;
+function  StrLen(p:pchar):longint;
+function  StrEnd(p:pchar):pchar;
+function  StrCat(Dest, Source:pchar): PChar;
+function  StrCat(Dest:pchar; Source: string): PChar;
+function  StrCat(var Dest:string; Source: pchar): String;
+function  StrIns(Dest:pchar; Source: string): PChar;
+function  StrMove(Dest, Source: PChar; Count: longint): PChar;
+function  StrCopy(Dest, Source: PChar): Pchar;
+function  StrLCopy(Dest, Source: PChar; MaxLen: longint): PChar;
+function  StrScan(str:pchar;ch:char):PChar;
+function  StrRScan(str:pchar;ch:char):PChar;
+function  StrTer(str:pchar;l:longint):pchar;
+
+
+{
+  $Log$
+  Revision 1.1  1998-04-10 15:17:46  michael
+  + Initial implementation; Donated by Gertjan Schouten
+    His file was split into several files, to keep it a little bit structured.
+
+}

rtl/objpas/sysstr.inc

@@ -0,0 +1,140 @@
+{
+    *********************************************************************
+    $Id$
+    Copyright (C) 1997, 1998 Gertjan Schouten
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+    *********************************************************************
+
+    System Utilities For Free Pascal
+}
+
+{ string manipulation functions }
+
+function setLength(var s:string; newLength:longint):longint;
+begin
+if (newLength > 255) then
+   newLength := 255;
+s[0] := char(newLength);
+setLength := ord(s[0]);
+end ;
+
+function UpperCase(s: string): string;
+var l:longint;
+begin
+l := Length(S);
+while l <> 0 do begin
+   if (s[l] in ['a'..'z']) then s[l] := char(byte(s[l]) - 32);
+   dec(l);
+   end;
+uppercase := s;
+end;
+
+function LowerCase(s: string): string;
+var l:longint;
+begin
+l := Length(S);
+while l <> 0 do begin
+   if (s[l] in ['A'..'Z']) then s[l] := char(byte(s[l]) + 32);
+   dec(l);
+   end;
+LowerCase := s;
+end;
+
+{!$I ANSI.PPI}
+
+function AnsiUpperCase(s: string):string;
+begin
+end ;
+
+function AnsiLowerCase(s: string):string;
+begin
+end ;
+
+function left(s: string;i:Longint): string;
+begin
+left := copy(s,1,i);
+end ;
+
+function right(s: string;i:Longint): string;
+begin
+right := copy(s,1 + length(s)-i,i);
+end ;
+
+function trim(s: string):string;
+var i,l:longint;
+begin
+l := length(s);
+while (s[l] = ' ') and (l > 0) do dec(l);
+setLength(s, l);
+i := 1;
+while (s[i] = ' ') and (i <= l) do inc(i);
+trim := copy(s, i, l);
+end ;
+
+function trimleft(s:string):string;
+var i,l:longint;
+begin
+l := length(s);
+i := 1;
+while (s[i] = ' ') and (i <= l) do inc(i);
+trimleft := copy(s, i, l);
+end ;
+
+function trimright(s:string):string;
+var l:longint;
+begin
+l := length(s);
+while (s[l] = ' ') and (l > 0) do dec(l);
+setLength(s, l);
+trimright := s;
+end ;
+
+{ Conversion stuff }
+
+function  IntToStr(l:longint):string;
+var result:string;
+begin
+system.str(l,result);
+inttostr := result;
+end ;
+
+function  StrToInt(s:string):longint;
+var result:longint;c:word;
+begin
+val(s, result, c);
+strtoint := result;
+end ;
+
+function  IntToHex(Value: longint; Digits: longint): string;
+var result:string;i:longint;
+begin
+result := '        ';
+setLength(result, digits);
+for i := 0 to digits - 1 do begin
+   result[digits - i] := HexDigits[value and 15];
+   value := value shr 4;
+   end ;
+inttohex := result;
+end ;
+
+
+{
+  $Log$
+  Revision 1.1  1998-04-10 15:17:46  michael
+  + Initial implementation; Donated by Gertjan Schouten
+    His file was split into several files, to keep it a little bit structured.
+
+}

rtl/objpas/sysstrh.inc

@@ -0,0 +1,49 @@
+{
+    *********************************************************************
+    $Id$
+    Copyright (C) 1997, 1998 Gertjan Schouten
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+    *********************************************************************
+
+    System Utilities For Free Pascal
+}
+
+{ String functions }
+
+function  setLength(var s: string; newLength: longint): longint;
+function  UpperCase(s: string): string;
+function  LowerCase(s: string): string;
+function  AnsiUpperCase(s: string): string;
+function  AnsiLowerCase(s: string): string;
+function  Left(s: string; i: longint): string;
+function  Right(s: string; i: longint): string;
+function  Trim(s: string): string;
+function  TrimLeft(s: string): string;
+function  TrimRight(s: string): string;
+
+{ Conversion Functions }
+
+function  IntToStr(l:longint):string;
+function  StrToInt(s:string):longint;
+function  IntToHex(Value: longint; Digits: longint): string;
+
+{
+  $Log$
+  Revision 1.1  1998-04-10 15:17:46  michael
+  + Initial implementation; Donated by Gertjan Schouten
+    His file was split into several files, to keep it a little bit structured.
+
+}