diff --git a/rtl/inc/dos.inc b/rtl/inc/dos.inc new file mode 100644 index 0000000000..97b6c80c20 --- /dev/null +++ b/rtl/inc/dos.inc @@ -0,0 +1,297 @@ +{ + $Id$ + This file is part of the Free Pascal run time library. + Copyright (c) 2004 by Tomas Hajny, + member of the Free Pascal development team. + + Common implementations of functions for unit Dos + (including dummy implementation of some functions for platforms + missing real implementation). + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + 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. + + **********************************************************************} + +(* Everywhere the same now, but prepared for potential difference. *) +const + ExtensionSeparator = '.'; + +{$IFNDEF HAS_DOSEXITCODE} + {$IFDEF HASTHREADVAR} +threadvar + {$ELSE HASTHREADVAR} +var + {$ENDIF HASTHREADVAR} + LastDosExitCode: longint; + + +function DosExitCode: word; +begin + if LastDosExitCode > high (word) then + DosExitCode := high (word) + else + DosExitCode := LastDosExitCode and $FFFF; +end; +{$ENDIF HAS_DOSEXITCODE} + + +{$IFNDEF HAS_GETMSCOUNT} + {$WARNING Real GetMsCount implementation missing, dummy version used} +{Dummy implementation of GetMsCount for platforms missing anything better.} +function GetMsCount: int64; +var + Y, Mo, D, WD, H, Mi, S, S100: word; +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)); + + function Leap: boolean; + begin + if (Y mod 400) = 0 then + Leap := true + else + if ((Y mod 100) = 0) or ((Y mod 4) <> 0) then + Leap := false + else + Leap := true; + end; + + {$IFDEF VER1_0} +{ Necessary to avoid internal error 10... :-( } +var + DC: cardinal; + I64: int64; + {$ENDIF VER1_0} +begin + GetDate (Y, Mo, D, WD); + GetTime (H, Mi, S, S100); + {$IFDEF VER1_0} + DC := D + DayTable [Leap, Mo] + (Y div 400) * 97; + DC := DC + ((Y mod 400) div 100) * 24 + (Y mod 100) div 4; + I64 := S100 * 10 + S * 1000; + I64 := I64 + cardinal (Mi) * 60*1000; + I64 := I64 + int64 (H) * 60*60*1000; + I64 := I64 + int64 (DC) * 24*60*60*1000; + I64 := I64 + int64 (Y) * 365*24*60*60*1000; + GetMsCount := I64; + {$ELSE VER1_0} + GetMsCount := S100 * 10 + S * 1000 + cardinal (Mi) * 60*1000 + + int64 (H) * 60*60*1000 + + int64 (D + DayTable [Leap, Mo] + + (Y div 400) * 97 + ((Y mod 400) div 100) * 24 + (Y mod 100) div 4) + * 24*60*60*1000 + + int64 (Y) * 365*24*60*60*1000; + {$ENDIF VER1_0} +end; +{$ENDIF HAS_GETMSCOUNT} + + +{$IFNDEF HAS_GETCBREAK} +procedure GetCBreak (var BreakValue: boolean); +begin + BreakValue := true; +end; +{$ENDIF HAS_GETCBREAK} + + +{$IFNDEF HAS_SETCBREAK} +procedure SetCBreak (BreakValue: boolean); +begin +end; +{$ENDIF HAS_SETCBREAK} + + +{$IFNDEF HAS_GETVERIFY} +procedure GetVerify (var Verify: boolean); +begin + Verify := true; +end; +{$ENDIF HAS_GETVERIFY} + + +{$IFNDEF HAS_SETVERIFY} +procedure SetVerify (Verify: boolean); +begin +end; +{$ENDIF HAS_SETVERIFY} + + +{$IFDEF CPUI386} + {$IFNDEF HAS_INTR} +procedure Intr (IntNo: byte; var Regs: Registers); +begin +end; + {$ENDIF HAS_INTR} + + + {$IFNDEF HAS_MSDOS} +procedure MSDos (var Regs: Registers); +begin + Intr ($21, Regs); +end; + {$ENDIF HAS_MSDOS} +{$ENDIF CPUI386} + + +{$IFNDEF HAS_SWAPVECTORS} +procedure SwapVectors; +begin +end; +{$ENDIF HAS_SWAPVECTORS} + + +{$IFNDEF HAS_GETINTVEC} +procedure GetIntVec (IntNo: byte; var Vector: pointer); +begin + Vector := nil; +end; +{$ENDIF HAS_GETINTVEC} + + +{$IFNDEF HAS_SETINTVEC} +procedure SetIntVec (IntNo: byte; Vector: pointer); +begin +end; +{$ENDIF HAS_SETINTVEC} + + +{$IFNDEF HAS_KEEP} +procedure Keep (ExitCode: word); +begin +end; +{$ENDIF HAS_KEEP} + + +{$IFNDEF HAS_GETSHORTNAME} +function GetShortName (var P: String): boolean; +begin + GetShortName := true; +end; +{$ENDIF HAS_GETSHORTNAME} + + +{$IFNDEF HAS_GETLONGNAME} +function GetLongName (var P: String): boolean; +begin + GetLongName := true; +end; +{$ENDIF HAS_GETLONGNAME} + + +{PackTime is platform independent} +procedure PackTime (var T: DateTime; var P: longint); + +var zs:longint; + +begin + p:=-1980; + p:=p+t.year and 127; + p:=p shl 4; + p:=p+t.month; + p:=p shl 5; + p:=p+t.day; + p:=p shl 16; + zs:=t.hour; + zs:=zs shl 6; + zs:=zs+t.min; + zs:=zs shl 5; + zs:=zs+t.sec div 2; + p:=p+(zs and $ffff); +end; + +{UnpackTime is platform-independent} +procedure UnpackTime (P: longint; var T: DateTime); + +begin + t.sec:=(p and 31) * 2; + p:=p shr 5; + t.min:=p and 63; + p:=p shr 6; + t.hour:=p and 31; + p:=p shr 5; + t.day:=p and 31; + p:=p shr 5; + t.month:=p and 15; + p:=p shr 4; + t.year:=p+1980; +end; + + +{**************************************************************************** + A platform independent implementation of FSplit +****************************************************************************} + +{$IFNDEF HAS_FSPLIT} +Procedure FSplit (Path: PathStr; var Dir: DirStr; var Name: NameStr; var Ext: ExtStr); +var + DirEnd, ExtStart: cardinal; +begin + if DirectorySeparator = '/' then + { allow backslash as slash } + for DirEnd := 1 to Length (Path) do + begin + if Path [DirEnd] = '\' then Path [DirEnd] := DirectorySeparator + end + else + if DirectorySeparator = '\' then + { allow slash as backslash } + for DirEnd := 1 to Length (Path) do + if Path [DirEnd] = '/' then Path [DirEnd] := DirectorySeparator; + +{ Find the first DirectorySeparator or DriveSeparator from the end. } + DirEnd := Length (Path); + while (DirEnd > 0) and not (Path [DirEnd] in + [DirectorySeparator, DriveSeparator]) do + Dec (DirEnd); + +{ The first "extension" should be returned if LFN } +{ support not available, the last one otherwise. } + if LFNSupport then + begin + ExtStart := Length (Path); + while (ExtStart > DirEnd) and (Path [ExtStart] <> ExtensionSeparator) do + Dec (ExtStart); + if ExtStart = 0 then + ExtStart := Length (Path) + 1 + else + if Path [ExtStart] <> ExtensionSeparator then + ExtStart := Length (Path) + 1; + end + else + begin + ExtStart := DirEnd + 1; + while (ExtStart <= Length (Path)) and (Path [ExtStart] <> ExtensionSeparator) do + Inc (ExtStart); + end; + + Dir := Copy (Path, 1, DirEnd); + Name := Copy (Path, DirEnd + 1, ExtStart - DirEnd - 1); + Ext := Copy (Path, ExtStart, Length (Path) - ExtStart + 1); +end; +{$ENDIF HAS_FSPLIT} + + +{**************************************************************************** + A platform independent implementation of FExpand +****************************************************************************} + +{$IFNDEF HAS_FEXPAND} + +(* FExpand maintained in standalone include file for easier maintenance. *) +{$I fexpand.inc} + +{$ENDIF HAS_FEXPAND} + +{ + $Log$ + Revision 1.1 2004-11-28 12:33:35 hajny + * common implementation of platform independent functions for unit Dos + + +}