From 80e4fa2639dfcce68c43a34c289e0e77c69d44b1 Mon Sep 17 00:00:00 2001 From: michael Date: Fri, 10 Apr 1998 15:17:46 +0000 Subject: [PATCH] + Initial implementation; Donated by Gertjan Schouten His file was split into several files, to keep it a little bit structured. --- rtl/objpas/dati.inc | 309 +++++++++++++++++++++++++++++++++++++++++ rtl/objpas/datih.inc | 119 ++++++++++++++++ rtl/objpas/fina.inc | 106 ++++++++++++++ rtl/objpas/finah.inc | 38 +++++ rtl/objpas/syspch.inc | 288 ++++++++++++++++++++++++++++++++++++++ rtl/objpas/syspchh.inc | 49 +++++++ rtl/objpas/sysstr.inc | 140 +++++++++++++++++++ rtl/objpas/sysstrh.inc | 49 +++++++ 8 files changed, 1098 insertions(+) create mode 100644 rtl/objpas/dati.inc create mode 100644 rtl/objpas/datih.inc create mode 100644 rtl/objpas/fina.inc create mode 100644 rtl/objpas/finah.inc create mode 100644 rtl/objpas/syspch.inc create mode 100644 rtl/objpas/syspchh.inc create mode 100644 rtl/objpas/sysstr.inc create mode 100644 rtl/objpas/sysstrh.inc diff --git a/rtl/objpas/dati.inc b/rtl/objpas/dati.inc new file mode 100644 index 0000000000..662cc68daf --- /dev/null +++ b/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. + +} \ No newline at end of file diff --git a/rtl/objpas/datih.inc b/rtl/objpas/datih.inc new file mode 100644 index 0000000000..0686582f10 --- /dev/null +++ b/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. + + +} \ No newline at end of file diff --git a/rtl/objpas/fina.inc b/rtl/objpas/fina.inc new file mode 100644 index 0000000000..5fccc34109 --- /dev/null +++ b/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. + +} \ No newline at end of file diff --git a/rtl/objpas/finah.inc b/rtl/objpas/finah.inc new file mode 100644 index 0000000000..eb463c1910 --- /dev/null +++ b/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. + +} diff --git a/rtl/objpas/syspch.inc b/rtl/objpas/syspch.inc new file mode 100644 index 0000000000..d57529272b --- /dev/null +++ b/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. + +} \ No newline at end of file diff --git a/rtl/objpas/syspchh.inc b/rtl/objpas/syspchh.inc new file mode 100644 index 0000000000..9806d90658 --- /dev/null +++ b/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. + +} diff --git a/rtl/objpas/sysstr.inc b/rtl/objpas/sysstr.inc new file mode 100644 index 0000000000..b2d8b88ff8 --- /dev/null +++ b/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. + +} \ No newline at end of file diff --git a/rtl/objpas/sysstrh.inc b/rtl/objpas/sysstrh.inc new file mode 100644 index 0000000000..3eb59c235a --- /dev/null +++ b/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. + +}