paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 05:29:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

* reinserted old version, because daniel skipped 3 versions !!

Browse Source
This commit is contained in:
peter 1998-12-30 10:26:16 +00:00
parent 71f87a0367
commit cb4cbe4f2a
1 changed files with 28 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
rtl/inc/objects.pp
View File

@ -210,7 +210,7 @@ const
{$IFDEF MAC} {$IFDEF MAC}
type type
FNameStr = String; FNameStr = String;
THandle = ??????? THandle = Integer;
const const
MaxReadBytes = $fffe; MaxReadBytes = $fffe;
invalidhandle = -1; invalidhandle = -1;
@ -687,7 +687,6 @@ CONST
{ STREAM REGISTRATION RECORDS } { STREAM REGISTRATION RECORDS }
{---------------------------------------------------------------------------} {---------------------------------------------------------------------------}
{$ifndef VER0_99_8}
CONST CONST
RCollection: TStreamRec = ( RCollection: TStreamRec = (
ObjType: 50; ObjType: 50;
@ -718,7 +717,6 @@ CONST
VmtLink: Ofs(TypeOf(TStrListMaker)^); VmtLink: Ofs(TypeOf(TStrListMaker)^);
Load: Nil; Load: Nil;
Store: @TStrListMaker.Store); Store: @TStrListMaker.Store);
{$endif VER0_99_8}
{<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>} {<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>}
IMPLEMENTATION IMPLEMENTATION
@ -734,7 +732,7 @@ type
PointerConstructor = function(VMT: pointer; Obj: pointer; Param1: pointer): pointer; PointerConstructor = function(VMT: pointer; Obj: pointer; Param1: pointer): pointer;
PointerMethod = function(Obj: pointer; Param1: pointer): pointer; PointerMethod = function(Obj: pointer; Param1: pointer): pointer;
function CurrentFramePointer: FramePointer;assembler; function PreviousFramePointer: FramePointer;assembler;
asm asm
{$ifdef i386} {$ifdef i386}
movl (%ebp), %eax movl (%ebp), %eax
@ -1191,7 +1189,7 @@ BEGIN
Success := SetFilePos(Handle, 0, 0, Position); { Reset to file start } Success := SetFilePos(Handle, 0, 0, Position); { Reset to file start }
End Else Success := 103; { Open file failed } End Else Success := 103; { Open file failed }
If (Handle = 0) OR (Success <> 0) Then Begin { Open failed } If (Handle = 0) OR (Success <> 0) Then Begin { Open failed }
Handle := invalidhandle; { Reset invalid handle } Handle := InvalidHandle; { Reset invalid handle }
Error(stInitError, Success); { Call stream error } Error(stInitError, Success); { Call stream error }
End; End;
END; END;
@ -1201,7 +1199,7 @@ END;
{---------------------------------------------------------------------------} {---------------------------------------------------------------------------}
DESTRUCTOR TDosStream.Done; DESTRUCTOR TDosStream.Done;
BEGIN BEGIN
If (Handle <> -1) Then FileClose(Handle); { Close the file } If (Handle <> InvalidHandle) Then FileClose(Handle); { Close the file }
Inherited Done; { Call ancestor } Inherited Done; { Call ancestor }
END; END;
@ -1210,9 +1208,9 @@ END;
{---------------------------------------------------------------------------} {---------------------------------------------------------------------------}
PROCEDURE TDosStream.Close; PROCEDURE TDosStream.Close;
BEGIN BEGIN
If (Handle <> -1) Then FileClose(Handle); { Close the file } If (Handle <> InvalidHandle) Then FileClose(Handle); { Close the file }
Position := 0; { Zero the position } Position := 0; { Zero the position }
Handle := invalidhandle; { Handle now invalid } Handle := -1; { Handle now invalid }
END; END;
{--TDosStream---------------------------------------------------------------} {--TDosStream---------------------------------------------------------------}
@ -1236,8 +1234,7 @@ VAR Success: Integer; Li: LongInt;
BEGIN BEGIN
If (Status=stOk) Then Begin { Check status okay } If (Status=stOk) Then Begin { Check status okay }
If (Pos < 0) Then Pos := 0; { Negatives removed } If (Pos < 0) Then Pos := 0; { Negatives removed }
If (Handle = invalidhandle) Then Success := 103 If (Handle = InvalidHandle) Then Success := 103 Else { File not open }
Else { File not open }
Success := SetFilePos(Handle, Pos, 0, Li); { Set file position } Success := SetFilePos(Handle, Pos, 0, Li); { Set file position }
If ((Success = -1) OR (Li <> Pos)) Then Begin { We have an error } If ((Success = -1) OR (Li <> Pos)) Then Begin { We have an error }
If (Success = -1) Then Error(stSeekError, 0) { General seek error } If (Success = -1) Then Error(stSeekError, 0) { General seek error }
@ -1252,11 +1249,11 @@ END;
PROCEDURE TDosStream.Open (OpenMode: Word); PROCEDURE TDosStream.Open (OpenMode: Word);
BEGIN BEGIN
If (Status=stOk) Then Begin { Check status okay } If (Status=stOk) Then Begin { Check status okay }
If (Handle = -1) Then Begin { File not open } If (Handle = InvalidHandle) Then Begin { File not open }
Handle := FileOpen(FName, OpenMode); { Open the file } Handle := FileOpen(FName, OpenMode); { Open the file }
Position := 0; { Reset position } Position := 0; { Reset position }
If (Handle=0) Then Begin { File open failed } If (Handle=0) Then Begin { File open failed }
Handle := invalidhandle; { Reset handle } Handle := InvalidHandle; { Reset handle }
Error(stOpenError, 103); { Call stream error } Error(stOpenError, 103); { Call stream error }
End; End;
End Else Error(stOpenError, 104); { File already open } End Else Error(stOpenError, 104); { File already open }
@ -1271,7 +1268,7 @@ VAR Success: Integer; W, BytesMoved: Sw_Word; P: PByteArray;
BEGIN BEGIN
If (Position + Count > StreamSize) Then { Insufficient data } If (Position + Count > StreamSize) Then { Insufficient data }
Error(stReadError, 0); { Read beyond end!!! } Error(stReadError, 0); { Read beyond end!!! }
If (Handle = -1) Then Error(stReadError, 103); { File not open } If (Handle = InvalidHandle) Then Error(stReadError, 103); { File not open }
P := @Buf; { Transfer address } P := @Buf; { Transfer address }
While (Count>0) AND (Status=stOk) Do Begin { Check status & count } While (Count>0) AND (Status=stOk) Do Begin { Check status & count }
W := Count; { Transfer read size } W := Count; { Transfer read size }
@ -1297,7 +1294,7 @@ END;
PROCEDURE TDosStream.Write (Var Buf; Count: Sw_Word); PROCEDURE TDosStream.Write (Var Buf; Count: Sw_Word);
VAR Success: Integer; W, BytesMoved: Sw_Word; P: PByteArray; VAR Success: Integer; W, BytesMoved: Sw_Word; P: PByteArray;
BEGIN BEGIN
If (Handle = -1) Then Error(stWriteError, 103); { File not open } If (Handle = InvalidHandle) Then Error(stWriteError, 103); { File not open }
P := @Buf; { Transfer address } P := @Buf; { Transfer address }
While (Count>0) AND (Status=stOk) Do Begin { Check status & count } While (Count>0) AND (Status=stOk) Do Begin { Check status & count }
W := Count; { Transfer read size } W := Count; { Transfer read size }
@ -1359,7 +1356,7 @@ PROCEDURE TBufStream.Flush;
VAR Success: Integer; W: Sw_Word; VAR Success: Integer; W: Sw_Word;
BEGIN BEGIN
If (LastMode=2) AND (BufPtr<>0) Then Begin { Must update file } If (LastMode=2) AND (BufPtr<>0) Then Begin { Must update file }
If (Handle = -1) Then Success := 103 { File is not open } If (Handle = InvalidHandle) Then Success := 103 { File is not open }
Else Success := FileWrite(Handle, Buffer^, Else Success := FileWrite(Handle, Buffer^,
BufPtr, W); { Write to file } BufPtr, W); { Write to file }
If (Success<>0) OR (W<>BufPtr) Then { We have an error } If (Success<>0) OR (W<>BufPtr) Then { We have an error }
@ -1412,7 +1409,7 @@ VAR Success: Integer; W, Bw: Sw_Word; P: PByteArray;
BEGIN BEGIN
If (Position + Count > StreamSize) Then { Read pas stream end } If (Position + Count > StreamSize) Then { Read pas stream end }
Error(stReadError, 0); { Call stream error } Error(stReadError, 0); { Call stream error }
If (Handle = -1) Then Error(stReadError, 103); { File not open } If (Handle = InvalidHandle) Then Error(stReadError, 103); { File not open }
P := @Buf; { Transfer address } P := @Buf; { Transfer address }
If (LastMode=2) Then Flush; { Flush write buffer } If (LastMode=2) Then Flush; { Flush write buffer }
LastMode := 1; { Now set read mode } LastMode := 1; { Now set read mode }
@ -1451,7 +1448,7 @@ END;
PROCEDURE TBufStream.Write (Var Buf; Count: Sw_Word); PROCEDURE TBufStream.Write (Var Buf; Count: Sw_Word);
VAR Success: Integer; W: Sw_Word; P: PByteArray; VAR Success: Integer; W: Sw_Word; P: PByteArray;
BEGIN BEGIN
If (Handle = -1) Then Error(stWriteError, 103); { File not open } If (Handle = InvalidHandle) Then Error(stWriteError, 103); { File not open }
If (LastMode=1) Then Flush; { Flush read buffer } If (LastMode=1) Then Flush; { Flush read buffer }
LastMode := 2; { Now set write mode } LastMode := 2; { Now set write mode }
P := @Buf; { Transfer address } P := @Buf; { Transfer address }
@ -1717,7 +1714,7 @@ VAR I: LongInt;
BEGIN BEGIN
For I := Count DownTo 1 Do For I := Count DownTo 1 Do
Begin { Down from last item } Begin { Down from last item }
IF CallPointerLocal(Test,CurrentFramePointer,Items^[I-1])<>NIL THEN IF Boolean(Longint(CallPointerLocal(Test,PreviousFramePointer,Items^[I-1]))) THEN
Begin { Test each item } Begin { Test each item }
LastThat := Items^[I-1]; { Return item } LastThat := Items^[I-1]; { Return item }
Exit; { Now exit } Exit; { Now exit }
@ -1733,7 +1730,7 @@ FUNCTION TCollection.FirstThat (Test: Pointer): Pointer;
VAR I: LongInt; VAR I: LongInt;
BEGIN BEGIN
For I := 1 To Count Do Begin { Up from first item } For I := 1 To Count Do Begin { Up from first item }
IF CallPointerLocal(Test,CurrentFramePointer,Items^[I-1])<>NIL THEN IF Boolean(Longint(CallPointerLocal(Test,PreviousFramePointer,Items^[I-1]))) THEN
Begin { Test each item } Begin { Test each item }
FirstThat := Items^[I-1]; { Return item } FirstThat := Items^[I-1]; { Return item }
Exit; { Now exit } Exit; { Now exit }
@ -1846,7 +1843,7 @@ PROCEDURE TCollection.ForEach (Action: Pointer);
VAR I: LongInt; VAR I: LongInt;
BEGIN BEGIN
For I := 1 To Count Do { Up from first item } For I := 1 To Count Do { Up from first item }
CallPointerLocal(Action,CurrentFramePointer,Items^[I-1]); { Call with each item } CallPointerLocal(Action,PreviousFramePointer,Items^[I-1]); { Call with each item }
END; END;
{--TCollection--------------------------------------------------------------} {--TCollection--------------------------------------------------------------}
@ -2652,11 +2649,9 @@ END;
{---------------------------------------------------------------------------} {---------------------------------------------------------------------------}
PROCEDURE RegisterObjects; PROCEDURE RegisterObjects;
BEGIN BEGIN
{$ifndef VER0_99_8}
RegisterType(RCollection); { Register object } RegisterType(RCollection); { Register object }
RegisterType(RStringCollection); { Register object } RegisterType(RStringCollection); { Register object }
RegisterType(RStrCollection); { Register object } RegisterType(RStrCollection); { Register object }
{$endif}
END; END;
{---------------------------------------------------------------------------} {---------------------------------------------------------------------------}
@ -2697,11 +2692,18 @@ END;
END. END.
{ {
$Log$ $Log$
Revision 1.21 1998-12-23 20:30:45 michael Revision 1.22 1998-12-30 10:26:16 peter
removed CR characters * reinserted old version, because daniel skipped 3 versions !!
Revision 1.20 1998/12/23 13:31:48 daniel Revision 1.19 1998/12/18 17:21:28 peter
+ invalidhandle constant * fixed firstthat,lastthat
Revision 1.18 1998/12/16 21:57:20 peter
* fixed currentframe,previousframe
+ testcall to test the callspec unit
Revision 1.17 1998/12/16 00:22:25 peter
* more temp symbols removed
Revision 1.16 1998/12/08 10:11:27 peter Revision 1.16 1998/12/08 10:11:27 peter
* tpoint contains now sw_integer (needed to support 64k files in the * tpoint contains now sw_integer (needed to support 64k files in the