* some problems with ansi string support fixed

This commit is contained in:
florian 1998-07-13 21:19:07 +00:00
parent 0912889c24
commit ba57d2813b
8 changed files with 54 additions and 38 deletions

View File

@ -48,8 +48,6 @@ const
var var
errno : integer; errno : integer;
type
plongint = ^longint;
{$S-} {$S-}
procedure Stack_Check; assembler; procedure Stack_Check; assembler;
@ -635,7 +633,10 @@ end.
{ {
$Log$ $Log$
Revision 1.5 1998-07-13 12:34:13 carl Revision 1.6 1998-07-13 21:19:07 florian
* some problems with ansi string support fixed
Revision 1.5 1998/07/13 12:34:13 carl
+ Error2InoutRes implemented + Error2InoutRes implemented
* do_read was doing a wrong os call! * do_read was doing a wrong os call!
* do_open was not pushing the right values * do_open was not pushing the right values

View File

@ -127,8 +127,7 @@ implementation
const const
carryflag = 1; carryflag = 1;
type
plongint = ^longint;
var var
doscmd : string[128]; { Dos commandline copied from PSP, max is 128 chars } doscmd : string[128]; { Dos commandline copied from PSP, max is 128 chars }
@ -1058,7 +1057,10 @@ Begin
End. End.
{ {
$Log$ $Log$
Revision 1.11 1998-07-07 12:33:08 carl Revision 1.12 1998-07-13 21:19:08 florian
* some problems with ansi string support fixed
Revision 1.11 1998/07/07 12:33:08 carl
* added 2k buffer for stack checking for correct io on error * added 2k buffer for stack checking for correct io on error
Revision 1.10 1998/07/02 12:29:20 carl Revision 1.10 1998/07/02 12:29:20 carl

View File

@ -41,7 +41,7 @@ Function NewAnsiString (Len : Longint) : AnsiString; forward;
Procedure DisposeAnsiString (Var S : AnsiString); forward; Procedure DisposeAnsiString (Var S : AnsiString); forward;
Procedure Decr_Ansi_Ref (Var S : AnsiString); forward; Procedure Decr_Ansi_Ref (Var S : AnsiString); forward;
Procedure Incr_Ansi_Ref (Var S : AnsiString); forward; Procedure Incr_Ansi_Ref (Var S : AnsiString); forward;
Procedure AssignAnsiString (Var S1 : AnsiString; S2 : AnsiString); Procedure AssignAnsiString (Var S1 : AnsiString; S2 : AnsiString); forward;
Procedure Ansi_String_Concat (Var S1 : AnsiString; Const S2 : AnsiString); forward; Procedure Ansi_String_Concat (Var S1 : AnsiString; Const S2 : AnsiString); forward;
Procedure Ansi_ShortString_Concat (Var S1: AnsiString; Const S2 : ShortString); forward; Procedure Ansi_ShortString_Concat (Var S1: AnsiString; Const S2 : ShortString); forward;
Procedure Ansi_To_ShortString (Var S1 : ShortString; Const S2 : AnsiString; maxlen : longint); forward; Procedure Ansi_To_ShortString (Var S1 : ShortString; Const S2 : AnsiString; maxlen : longint); forward;
@ -59,9 +59,6 @@ Type TAnsiRec = Record
end; end;
PAnsiRec = ^TAnsiRec; PAnsiRec = ^TAnsiRec;
PLongint = ^Longint;
PByte = ^Byte;
Const AnsiRecLen = SizeOf(TAnsiRec); Const AnsiRecLen = SizeOf(TAnsiRec);
FirstOff = SizeOf(TAnsiRec)-1; FirstOff = SizeOf(TAnsiRec)-1;
@ -325,7 +322,7 @@ end;
Procedure Write_Text_AnsiString (Len : Longint; T : TextRec; Var S : AnsiString);[Public, alias 'WRITE_TEXT_ANSISTRING']; Procedure Write_Text_AnsiString (Len : Longint; T : TextRec; Var S : AnsiString);[Public, alias: 'WRITE_TEXT_ANSISTRING'];
{ {
Writes a AnsiString to the Text file T Writes a AnsiString to the Text file T
} }
@ -368,7 +365,7 @@ Procedure SetLength (Var S : AnsiString; l : Longint);
Var Temp : Pointer; Var Temp : Pointer;
begin begin
If (S=Nil) and (l>0) then If (Pointer(S)=Nil) and (l>0) then
begin begin
{ Need a complete new string...} { Need a complete new string...}
S:=NewAnsiString(l); S:=NewAnsiString(l);
@ -384,9 +381,9 @@ begin
{ Reallocation is needed... } { Reallocation is needed... }
Temp:=Pointer(NewAnsiString(L)); Temp:=Pointer(NewAnsiString(L));
if Length(S)>0 then if Length(S)>0 then
Move (S^,Temp^,Length(S)+1); Move (Pointer(S)^,Temp^,Length(S)+1);
Decr_Ansi_ref (S); Decr_Ansi_ref (S);
S:=Temp; S:=AnsiString(Temp);
end; end;
PAnsiRec(Pointer(S)-FirstOff)^.Len:=l PAnsiRec(Pointer(S)-FirstOff)^.Len:=l
end end
@ -418,7 +415,7 @@ begin
PByte(ResultAddress+Size)^:=0; PByte(ResultAddress+Size)^:=0;
end; end;
end; end;
Copy:=ResultAddress; Copy:=AnsiString(ResultAddress);
end; end;
@ -438,7 +435,7 @@ begin
begin begin
inc (i); inc (i);
S:=Pointer(copy(Source,i,length(Substr))); S:=Pointer(copy(Source,i,length(Substr)));
if AnsiCompare(substr,s)=0 then if AnsiCompare(substr,AnsiString(s))=0 then
begin begin
j := i; j := i;
e := false; e := false;
@ -547,7 +544,7 @@ begin
System.Val(SS,SI,Code); System.Val(SS,SI,Code);
end; end;
{
Procedure Str (Const R : Real;Len,fr : Longint; Var S : AnsiString); Procedure Str (Const R : Real;Len,fr : Longint; Var S : AnsiString);
Var SS : ShortString; Var SS : ShortString;
@ -624,7 +621,7 @@ Procedure Str (Const SI : ShortInt; Len : Longint; Var S : AnsiString);
begin begin
end; end;
}
Procedure Delete (Var S : AnsiString; Index,Size: Longint); Procedure Delete (Var S : AnsiString; Index,Size: Longint);
@ -672,7 +669,10 @@ end;
{ {
$Log$ $Log$
Revision 1.7 1998-07-06 14:29:08 michael Revision 1.8 1998-07-13 21:19:09 florian
* some problems with ansi string support fixed
Revision 1.7 1998/07/06 14:29:08 michael
+ Added Public,Alias directives for some calls + Added Public,Alias directives for some calls
Revision 1.6 1998/06/25 08:41:44 florian Revision 1.6 1998/06/25 08:41:44 florian

View File

@ -158,7 +158,11 @@ begin
insert ('.',temp,3); insert ('.',temp,3);
str(abs(correct),power); str(abs(correct),power);
if length(power)<explen-2 then if length(power)<explen-2 then
{$ifndef USEANSISTRINGS} {!!!!!!!!! this doesn't work with ansi strings }
power:=copy(zero,1,explen-2-length(power))+power; power:=copy(zero,1,explen-2-length(power))+power;
{$else USEANSISTRINGS}
;
{$endif USEANSISTRINGS}
if correct<0 then power:='-'+power else power:='+'+power; if correct<0 then power:='-'+power else power:='+'+power;
temp:=temp+'E'+power; temp:=temp+'E'+power;
end end
@ -198,7 +202,10 @@ end;
{ {
$Log$ $Log$
Revision 1.4 1998-06-18 08:15:33 michael Revision 1.5 1998-07-13 21:19:10 florian
* some problems with ansi string support fixed
Revision 1.4 1998/06/18 08:15:33 michael
+ Fixed error when printing zero. len was calculated wron. + Fixed error when printing zero. len was calculated wron.
Revision 1.3 1998/05/12 10:42:45 peter Revision 1.3 1998/05/12 10:42:45 peter

View File

@ -24,12 +24,6 @@ Const
tkArray = 13; tkArray = 13;
tkRecord = 14; tkRecord = 14;
{ Some useful types }
Type
PByte = ^Byte;
{ A record is designed as follows : { A record is designed as follows :
1 : tkrecord 1 : tkrecord
2 : Length of name string (n); 2 : Length of name string (n);
@ -40,6 +34,8 @@ Type
Offset in record Offset in record
} }
Type
TRecElem = Record TRecElem = Record
Info : Pointer; Info : Pointer;
Offset : Longint; Offset : Longint;
@ -75,7 +71,10 @@ TArrayRec = record
{ {
$Log$ $Log$
Revision 1.2 1998-06-08 15:32:15 michael Revision 1.3 1998-07-13 21:19:11 florian
* some problems with ansi string support fixed
Revision 1.2 1998/06/08 15:32:15 michael
+ Split rtti according to processor. Implemented optimized i386 code. + Split rtti according to processor. Implemented optimized i386 code.
} }

View File

@ -112,6 +112,10 @@ Procedure Rewrite(var f : TypedFile); [INTERNPROC: In_Rewrite_TypedFile];
{$ifdef UseAnsiStrings} {$ifdef UseAnsiStrings}
Type
PLongint = ^Longint;
PByte = ^Byte;
{$i astrings.pp} {$i astrings.pp}
{$else} {$else}
@ -493,7 +497,10 @@ End;
{ {
$Log$ $Log$
Revision 1.19 1998-07-08 11:56:55 carl Revision 1.20 1998-07-13 21:19:12 florian
* some problems with ansi string support fixed
Revision 1.19 1998/07/08 11:56:55 carl
* randon and Random(l) now work correctly - don't touch it works! * randon and Random(l) now work correctly - don't touch it works!
Revision 1.18 1998/07/02 13:01:55 carl Revision 1.18 1998/07/02 13:01:55 carl

View File

@ -47,9 +47,6 @@ Implementation
{$I system.inc} {$I system.inc}
Type
PLongint = ^Longint;
{$ifdef crtlib} {$ifdef crtlib}
Procedure _rtl_exit(l: longint); cdecl; Procedure _rtl_exit(l: longint); cdecl;
Function _rtl_paramcount: longint; cdecl; Function _rtl_paramcount: longint; cdecl;
@ -678,7 +675,10 @@ End.
{ {
$Log$ $Log$
Revision 1.7 1998-07-02 12:36:21 carl Revision 1.8 1998-07-13 21:19:14 florian
* some problems with ansi string support fixed
Revision 1.7 1998/07/02 12:36:21 carl
* IOCheck/InOutRes check for mkdir, chdir and rmdir as in TP * IOCheck/InOutRes check for mkdir, chdir and rmdir as in TP
Revision 1.6 1998/07/01 15:30:01 peter Revision 1.6 1998/07/01 15:30:01 peter

View File

@ -127,9 +127,6 @@ CONST
var var
errno : longint; errno : longint;
type
plongint = ^longint;
{ misc. functions } { misc. functions }
function GetLastError : DWORD; function GetLastError : DWORD;
external 'kernel32' name 'GetLastError'; external 'kernel32' name 'GetLastError';
@ -762,7 +759,10 @@ end.
{ {
$Log$ $Log$
Revision 1.12 1998-07-07 12:37:28 carl Revision 1.13 1998-07-13 21:19:15 florian
* some problems with ansi string support fixed
Revision 1.12 1998/07/07 12:37:28 carl
* correct mapping of error codes for TP compatibility * correct mapping of error codes for TP compatibility
+ implemented stack checking in ifdef dummy + implemented stack checking in ifdef dummy