paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-02 15:39:26 +01:00
Code Issues Packages Projects Releases Wiki Activity

+ open strings, $P switch support

Browse Source
This commit is contained in:
peter 1998-11-27 14:50:30 +00:00
parent 162124d10c
commit a41f61713d
15 changed files with 242 additions and 125 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
compiler/cg386cal.pas
View File

@ -68,7 +68,7 @@ implementation
end;
procedure maybe_push_open_array_high;
procedure maybe_push_high;
var
r : preference;
hreg : tregister;
@ -78,7 +78,8 @@ implementation
{ open array ? }
{ defcoll^.data can be nil for read/write }
if assigned(defcoll^.data) and
is_open_array(defcoll^.data) then
(is_open_array(defcoll^.data) or
is_open_string(defcoll^.data)) then
begin
{ push high }
case p^.left^.resulttype^.deftype of
@ -93,17 +94,31 @@ implementation
parraydef(p^.left^.resulttype)^.lowrange
end;
stringdef : begin
if p^.left^.treetype=stringconstn then
len:=str_length(p^.left)
if is_open_string(defcoll^.data) then
begin
if is_open_string(p^.left^.resulttype) then
begin
r:=new_reference(highframepointer,highoffset+4);
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_EDI)));
hreg:=R_EDI;
len:=-2;
end
else
len:=pstringdef(p^.left^.resulttype)^.len
end
else
begin
href:=p^.left^.location.reference;
dec(href.offset);
hreg:=reg32toreg8(getregister32);
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_B,newreference(href),hreg)));
emit_to_reg32(hreg);
len:=-2;
end;
{ passing a string to an array of char }
begin
if (p^.left^.treetype=stringconstn) then
len:=str_length(p^.left)
else
begin
href:=p^.left^.location.reference;
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOVZX,S_BL,newreference(href),R_EDI)));
hreg:=R_EDI;
len:=-2;
end;
end;
end;
else
len:=0;
@ -218,7 +233,7 @@ implementation
begin
if (p^.left^.location.loc<>LOC_REFERENCE) then
CGMessage(cg_e_var_must_be_reference);
maybe_push_open_array_high;
maybe_push_high;
inc(pushedparasize,4);
if inlined then
begin
@ -242,7 +257,7 @@ implementation
{$endif}
push_addr(p^.left) then
begin
maybe_push_open_array_high;
maybe_push_high;
inc(pushedparasize,4);
if inlined then
begin
@ -530,7 +545,7 @@ implementation
is_open_array(defcoll^.data) then
begin
{ first, push high }
maybe_push_open_array_high;
maybe_push_high;
inc(pushedparasize,4);
if inlined then
begin
@ -1575,7 +1590,10 @@ implementation
end.
{
$Log$
Revision 1.47 1998-11-26 21:30:03 peter
Revision 1.48 1998-11-27 14:50:30 peter
+ open strings, $P switch support
Revision 1.47 1998/11/26 21:30:03 peter
* fix for valuepara
Revision 1.46 1998/11/26 14:39:10 peter

43
compiler/cg386inl.pas
View File

@ -203,6 +203,11 @@ implementation
CGMessage(parser_e_illegal_colon_qualifier);
if ft=ft_typed then
never_copy_const_param:=true;
{ reset data type }
dummycoll.data:=nil;
{ support openstring calling for readln(shortstring) }
if doread and (is_shortstring(hp^.resulttype)) then
dummycoll.data:=openshortstringdef;
secondcallparan(hp,@dummycoll,false,false,0);
if ft=ft_typed then
never_copy_const_param:=false;
@ -279,7 +284,6 @@ implementation
if doread then
begin
{ push maximum string length }
push_int(pstringdef(pararesult)^.len);
case pstringdef(pararesult)^.string_typ of
st_shortstring:
emitcall ('FPC_READ_TEXT_STRING',true);
@ -432,17 +436,16 @@ implementation
{ we have at least two args }
{ with at max 2 colon_para in between }
{ first arg longint or float }
{ string arg }
hp:=node;
node:=node^.right;
hp^.right:=nil;
dummycoll.data:=hp^.resulttype;
{ string arg }
dummycoll.paratyp:=vs_var;
secondcallparan(hp,@dummycoll,false
,false,0
);
if is_shortstring(hp^.resulttype) then
dummycoll.data:=openshortstringdef
else
dummycoll.data:=hp^.resulttype;
secondcallparan(hp,@dummycoll,false,false,0);
if codegenerror then
exit;
@ -586,15 +589,13 @@ implementation
end;
in_high_x :
begin
if is_open_array(p^.left^.resulttype) then
if is_open_array(p^.left^.resulttype) or
is_open_string(p^.left^.resulttype) then
begin
secondpass(p^.left);
del_reference(p^.left^.location.reference);
p^.location.register:=getregister32;
new(r);
reset_reference(r^);
r^.base:=highframepointer;
r^.offset:=highoffset+4;
r:=new_reference(highframepointer,highoffset+4);
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
r,p^.location.register)));
end
@ -604,21 +605,20 @@ implementation
begin
{ sizeof(openarray) handling }
if (p^.inlinenumber=in_sizeof_x) and
is_open_array(p^.left^.resulttype) then
(is_open_array(p^.left^.resulttype) or
is_open_string(p^.left^.resulttype)) then
begin
{ sizeof(openarray)=high(openarray)+1 }
secondpass(p^.left);
del_reference(p^.left^.location.reference);
p^.location.register:=getregister32;
new(r);
reset_reference(r^);
r^.base:=highframepointer;
r^.offset:=highoffset+4;
r:=new_reference(highframepointer,highoffset+4);
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
r,p^.location.register)));
exprasmlist^.concat(new(pai386,op_reg(A_INC,S_L,
p^.location.register)));
if parraydef(p^.left^.resulttype)^.elesize<>1 then
if (p^.left^.resulttype^.deftype=arraydef) and
(parraydef(p^.left^.resulttype)^.elesize<>1) then
exprasmlist^.concat(new(pai386,op_const_reg(A_IMUL,S_L,
parraydef(p^.left^.resulttype)^.elesize,p^.location.register)));
end
@ -970,7 +970,10 @@ implementation
end.
{
$Log$
Revision 1.19 1998-11-26 13:10:40 peter
Revision 1.20 1998-11-27 14:50:32 peter
+ open strings, $P switch support
Revision 1.19 1998/11/26 13:10:40 peter
* new int - int conversion -dNEWCNV
* some function renamings

25
compiler/cg386ld.pas
View File

@ -26,17 +26,6 @@ interface
uses
tree,i386;
var
{ this is for open arrays and strings }
{ but be careful, this data is in the }
{ generated code destroyed quick, and also }
{ the next call of secondload destroys this }
{ data }
{ So be careful using the informations }
{ provided by this variables }
highframepointer : tregister;
highoffset : longint;
procedure secondload(var p : ptree);
procedure secondassignment(var p : ptree);
procedure secondfuncret(var p : ptree);
@ -187,16 +176,17 @@ implementation
((pvarsym(p^.symtableentry)^.varspez=vs_const) and
{$ifndef VALUEPARA}
dont_copy_const_param(pvarsym(p^.symtableentry)^.definition)) or
{$else}
push_addr_param(pvarsym(p^.symtableentry)^.definition)) or
{$endif}
{ call by value open arrays are also indirect addressed }
is_open_array(pvarsym(p^.symtableentry)^.definition) then
{$else}
push_addr_param(pvarsym(p^.symtableentry)^.definition)) then
{$endif}
begin
simple_loadn:=false;
if hregister=R_NO then
hregister:=getregister32;
if is_open_array(pvarsym(p^.symtableentry)^.definition) then
if is_open_array(pvarsym(p^.symtableentry)^.definition) or
is_open_string(pvarsym(p^.symtableentry)^.definition) then
begin
if (p^.location.reference.base=procinfo.framepointer) then
begin
@ -689,7 +679,10 @@ implementation
end.
{
$Log$
Revision 1.32 1998-11-26 09:53:36 florian
Revision 1.33 1998-11-27 14:50:33 peter
+ open strings, $P switch support
Revision 1.32 1998/11/26 09:53:36 florian
* for classes no init/final. code is necessary, fixed
Revision 1.31 1998/11/20 15:35:54 florian

15
compiler/hcodegen.pas
View File

@ -131,6 +131,16 @@ unit hcodegen;
{ true, if an error while code generation occurs }
codegenerror : boolean;
{ this is for open arrays and strings }
{ but be careful, this data is in the }
{ generated code destroyed quick, and also }
{ the next call of secondload destroys this }
{ data }
{ So be careful using the informations }
{ provided by this variables }
highframepointer : tregister;
highoffset : longint;
{ message calls with codegenerror support }
procedure cgmessage(const t : tmsgconst);
procedure cgmessage1(const t : tmsgconst;const s : string);
@ -344,7 +354,10 @@ end.
{
$Log$
Revision 1.22 1998-11-16 12:12:21 peter
Revision 1.23 1998-11-27 14:50:38 peter
+ open strings, $P switch support
Revision 1.22 1998/11/16 12:12:21 peter
- generate_pascii which is obsolete
Revision 1.21 1998/11/04 10:11:38 peter

33
compiler/pexpr.pas
View File

@ -216,8 +216,9 @@ unit pexpr;
Must_be_valid:=false;
do_firstpass(p1);
if ((p1^.resulttype^.deftype=objectdef) and
((pobjectdef(p1^.resulttype)^.options and oo_hasconstructor)<>0))
or is_open_array(p1^.resulttype) then
((pobjectdef(p1^.resulttype)^.options and oo_hasconstructor)<>0)) or
is_open_array(p1^.resulttype) or
is_open_string(p1^.resulttype) then
statement_syssym:=geninlinenode(in_sizeof_x,false,p1)
else
begin
@ -1583,16 +1584,21 @@ unit pexpr;
p1:=genrealconstnode(d);
end;
_STRING : begin
{ STRING can be also a type cast }
pd:=stringtype;
consume(LKLAMMER);
p1:=comp_expr(true);
consume(RKLAMMER);
p1:=gentypeconvnode(p1,pd);
p1^.explizit:=true;
{ handle postfix operators here e.g. string(a)[10] }
again:=true;
postfixoperators;
{ STRING can be also a type cast }
if token=LKLAMMER then
begin
consume(LKLAMMER);
p1:=comp_expr(true);
consume(RKLAMMER);
p1:=gentypeconvnode(p1,pd);
p1^.explizit:=true;
{ handle postfix operators here e.g. string(a)[10] }
again:=true;
postfixoperators;
end
else
p1:=gentypenode(pd);
end;
_FILE : begin
pd:=cfiledef;
@ -1908,7 +1914,10 @@ unit pexpr;
end.
{
$Log$
Revision 1.75 1998-11-25 19:12:51 pierre
Revision 1.76 1998-11-27 14:50:40 peter
+ open strings, $P switch support
Revision 1.75 1998/11/25 19:12:51 pierre
* var:=new(pointer_type) support added
Revision 1.74 1998/11/13 10:18:11 peter

9
compiler/psystem.pas
View File

@ -93,6 +93,7 @@ begin
p^.insert(new(ptypesym,init('longstring',clongstringdef)));
p^.insert(new(ptypesym,init('ansistring',cansistringdef)));
p^.insert(new(ptypesym,init('widestring',cwidestringdef)));
p^.insert(new(ptypesym,init('openshortstring',openshortstringdef)));
p^.insert(new(ptypesym,init('word',u16bitdef)));
p^.insert(new(ptypesym,init('boolean',booldef)));
p^.insert(new(ptypesym,init('void_pointer',voidpointerdef)));
@ -168,6 +169,7 @@ begin
clongstringdef:=pstringdef(globaldef('longstring'));
cansistringdef:=pstringdef(globaldef('ansistring'));
cwidestringdef:=pstringdef(globaldef('widestring'));
openshortstringdef:=pstringdef(globaldef('openshortstring'));
cchardef:=porddef(globaldef('char'));
{$ifdef i386}
c64floatdef:=pfloatdef(globaldef('s64real'));
@ -209,6 +211,8 @@ begin
clongstringdef:=new(pstringdef,longinit(-1));
cansistringdef:=new(pstringdef,ansiinit(-1));
cwidestringdef:=new(pstringdef,wideinit(-1));
{ length=0 for shortstring is open string (needed for readln(string) }
openshortstringdef:=new(pstringdef,shortinit(0));
{$ifdef i386}
c64floatdef:=new(pfloatdef,init(s64real));
s80floatdef:=new(pfloatdef,init(s80real));
@ -232,7 +236,10 @@ end;
end.
{
$Log$
Revision 1.11 1998-11-16 10:18:09 peter
Revision 1.12 1998-11-27 14:50:45 peter
+ open strings, $P switch support
Revision 1.11 1998/11/16 10:18:09 peter
* fixes for ansistrings
Revision 1.10 1998/11/09 11:44:36 peter

7
compiler/switches.pas
View File

@ -57,7 +57,7 @@ const
{M} (typesw:localsw; setsw:ord(cs_generate_rtti)),
{N} (typesw:unsupportedsw; setsw:ord(cs_localnone)),
{O} (typesw:unsupportedsw; setsw:ord(cs_localnone)),
{P} (typesw:unsupportedsw; setsw:ord(cs_localnone)),
{P} (typesw:modulesw; setsw:ord(cs_openstring)),
{Q} (typesw:localsw; setsw:ord(cs_check_overflow)),
{R} (typesw:localsw; setsw:ord(cs_check_range)),
{S} (typesw:localsw; setsw:ord(cs_check_stack)),
@ -164,7 +164,10 @@ end;
end.
{
$Log$
Revision 1.16 1998-10-13 16:50:22 pierre
Revision 1.17 1998-11-27 14:50:46 peter
+ open strings, $P switch support
Revision 1.16 1998/10/13 16:50:22 pierre
* undid some changes of Peter that made the compiler wrong
for m68k (I had to reinsert some ifdefs)
* removed several memory leaks under m68k

10
compiler/symdef.inc
View File

@ -921,11 +921,6 @@
begin
datasegment^.concat(new(pai_const,init_32bit(low)));
datasegment^.concat(new(pai_const,init_32bit($7fffffff)));
inc(nextlabelnr);
if (cs_smartlink in aktmoduleswitches) then
datasegment^.concat(new(pai_symbol,init_global('R_'+current_module^.modulename^+tostr(rangenr+1))))
else
datasegment^.concat(new(pai_symbol,init('R_'+tostr(rangenr+1))));
datasegment^.concat(new(pai_const,init_32bit($80000000)));
datasegment^.concat(new(pai_const,init_32bit(high)));
end;
@ -3224,7 +3219,10 @@
{
$Log$
Revision 1.73 1998-11-26 14:47:00 michael
Revision 1.74 1998-11-27 14:50:47 peter
+ open strings, $P switch support
Revision 1.73 1998/11/26 14:47:00 michael
+ Fixed RTTI constants
Revision 1.72 1998/11/25 14:35:28 florian

22
compiler/symsym.inc
View File

@ -970,8 +970,9 @@
end;
vs_var : begin
{ open arrays push also the high valye }
if is_open_array(definition) then
getsize:=target_os.size_of_pointer+target_os.size_of_pointer
if is_open_array(definition) or
is_open_string(definition) then
getsize:=target_os.size_of_pointer+target_os.size_of_longint
else
getsize:=target_os.size_of_pointer;
end;
@ -983,9 +984,8 @@
setdef : getsize:=target_os.size_of_pointer;
arraydef : begin
{ open arrays push also the high valye }
if (parraydef(definition)^.lowrange=0) and
(parraydef(definition)^.highrange=-1) then
getsize:=target_os.size_of_pointer+target_os.size_of_pointer
if is_open_array(definition) then
getsize:=target_os.size_of_pointer+target_os.size_of_longint
else
getsize:=target_os.size_of_pointer;
end;
@ -1016,8 +1016,9 @@
vs_var :
begin
{ open arrays push also the high valye }
if is_open_array(definition) then
getpushsize:=target_os.size_of_pointer+target_os.size_of_pointer
if is_open_array(definition) or
is_open_string(definition) then
getpushsize:=target_os.size_of_pointer+target_os.size_of_longint
else
getpushsize:=target_os.size_of_pointer;
end;
@ -1032,7 +1033,7 @@
getpushsize:=target_os.size_of_pointer;
arraydef :
if is_open_array(definition) then
getpushsize:=target_os.size_of_pointer+target_os.size_of_pointer
getpushsize:=target_os.size_of_pointer+target_os.size_of_longint
else
getpushsize:=target_os.size_of_pointer;
else
@ -1803,7 +1804,10 @@
{
$Log$
Revision 1.61 1998-11-18 15:44:18 peter
Revision 1.62 1998-11-27 14:50:48 peter
+ open strings, $P switch support
Revision 1.61 1998/11/18 15:44:18 peter
* VALUEPARA for tp7 compatible value parameters
Revision 1.60 1998/11/16 10:13:51 peter

13
compiler/tccal.pas
View File

@ -164,9 +164,10 @@ implementation
firstpass(p^.left);
allow_array_constructor:=old_array_constructor;
end;
{ don't generate an type conversion for open arrays }
{ else we loss the ranges }
if is_open_array(defcoll^.data) then
{ don't generate an type conversion for open arrays and
openstring, else we loss the ranges }
if is_open_array(defcoll^.data) or
is_open_string(defcoll^.data) then
begin
{ insert type conv but hold the ranges of the array }
oldtype:=p^.left^.resulttype;
@ -190,6 +191,7 @@ implementation
is_shortstring(p^.left^.resulttype) and
is_shortstring(defcoll^.data) and
(defcoll^.paratyp=vs_var) and
not(is_open_string(defcoll^.data)) and
not(is_equal(p^.left^.resulttype,defcoll^.data)) then
CGMessage(type_e_strict_var_string_violation);
{ Variablen for call by reference may not be copied }
@ -978,7 +980,10 @@ implementation
end.
{
$Log$
Revision 1.13 1998-11-24 17:03:51 peter
Revision 1.14 1998-11-27 14:50:52 peter
+ open strings, $P switch support
Revision 1.13 1998/11/24 17:03:51 peter
* fixed exactmatch removings
Revision 1.12 1998/11/16 10:18:10 peter

79
compiler/tcinl.pas
View File

@ -780,43 +780,55 @@ implementation
end;
arraydef:
begin
if is_open_array(p^.left^.resulttype) then
begin
if p^.inlinenumber=in_low_x then
begin
hp:=genordinalconstnode(Parraydef(p^.left^.resulttype)^.lowrange,s32bitdef);
disposetree(p);
p:=hp;
firstpass(p);
end
else
begin
p^.resulttype:=s32bitdef;
p^.registers32:=max(1,
p^.registers32);
p^.location.loc:=LOC_REGISTER;
end;
end
if p^.inlinenumber=in_low_x then
begin
hp:=genordinalconstnode(Parraydef(p^.left^.resulttype)^.lowrange,s32bitdef);
disposetree(p);
p:=hp;
firstpass(p);
end
else
begin
if p^.inlinenumber=in_low_x then
hp:=genordinalconstnode(Parraydef(p^.left^.resulttype)^.lowrange,s32bitdef)
else
hp:=genordinalconstnode(Parraydef(p^.left^.resulttype)^.highrange,s32bitdef);
disposetree(p);
p:=hp;
firstpass(p);
end;
begin
if is_open_array(p^.left^.resulttype) then
begin
p^.resulttype:=s32bitdef;
p^.registers32:=max(1,p^.registers32);
p^.location.loc:=LOC_REGISTER;
end
else
begin
hp:=genordinalconstnode(Parraydef(p^.left^.resulttype)^.highrange,s32bitdef);
disposetree(p);
p:=hp;
firstpass(p);
end;
end;
end;
stringdef:
begin
if p^.inlinenumber=in_low_x then
hp:=genordinalconstnode(0,u8bitdef)
begin
hp:=genordinalconstnode(0,u8bitdef);
disposetree(p);
p:=hp;
firstpass(p);
end
else
hp:=genordinalconstnode(Pstringdef(p^.left^.resulttype)^.len,u8bitdef);
disposetree(p);
p:=hp;
firstpass(p);
begin
if is_open_string(p^.left^.resulttype) then
begin
p^.resulttype:=s32bitdef;
p^.registers32:=max(1,p^.registers32);
p^.location.loc:=LOC_REGISTER;
end
else
begin
hp:=genordinalconstnode(Pstringdef(p^.left^.resulttype)^.len,u8bitdef);
disposetree(p);
p:=hp;
firstpass(p);
end;
end;
end;
else
CGMessage(type_e_mismatch);
@ -863,7 +875,10 @@ implementation
end.
{
$Log$
Revision 1.9 1998-11-24 17:04:28 peter
Revision 1.10 1998-11-27 14:50:53 peter
+ open strings, $P switch support
Revision 1.9 1998/11/24 17:04:28 peter
* fixed length(char) when char is a variable
Revision 1.8 1998/11/14 10:51:33 peter

7
compiler/token.inc
View File

@ -169,6 +169,7 @@ type
_PUBLISHED,
_DESTRUCTOR,
_CONSTRUCTOR,
_SHORTSTRING,
_FINALIZATION,
_IMPLEMENTATION,
_INITIALIZATION
@ -327,6 +328,7 @@ const
(str:'PUBLISHED' ;special:false;keyword:m_none),
(str:'DESTRUCTOR' ;special:false;keyword:m_all),
(str:'CONSTRUCTOR' ;special:false;keyword:m_all),
(str:'SHORTSTRING' ;special:false;keyword:m_none),
(str:'FINALIZATION' ;special:false;keyword:m_class),
(str:'IMPLEMENTATION';special:false;keyword:m_all),
(str:'INITIALIZATION';special:false;keyword:m_class)
@ -334,7 +336,10 @@ const
{
$Log$
Revision 1.6 1998-11-13 15:40:33 pierre
Revision 1.7 1998-11-27 14:50:54 peter
+ open strings, $P switch support
Revision 1.6 1998/11/13 15:40:33 pierre
+ added -Se in Makefile cvstest target
+ lexlevel cleanup
normal_function_level main_program_level and unit_init_level defined

17
compiler/types.pas
View File

@ -46,6 +46,9 @@ unit types;
{ true if p is a char }
function is_char(def : pdef) : boolean;
{ true if p points to an open string def }
function is_open_string(p : pdef) : boolean;
{ true if p points to an open array def }
function is_open_array(p : pdef) : boolean;
@ -261,6 +264,15 @@ unit types;
end;
{ true, if p points to an open array def }
function is_open_string(p : pdef) : boolean;
begin
is_open_string:=(p^.deftype=stringdef) and
(pstringdef(p)^.string_typ=st_shortstring) and
(pstringdef(p)^.len=0);
end;
{ true, if p points to an open array def }
function is_open_array(p : pdef) : boolean;
begin
@ -1020,7 +1032,10 @@ unit types;
end.
{
$Log$
Revision 1.38 1998-11-18 15:44:24 peter
Revision 1.39 1998-11-27 14:50:55 peter
+ open strings, $P switch support
Revision 1.38 1998/11/18 15:44:24 peter
* VALUEPARA for tp7 compatible value parameters
Revision 1.37 1998/11/13 10:15:50 peter

12
rtl/inc/systemh.inc
View File

@ -24,7 +24,12 @@
Needed switches
****************************************************************************}
{$I-,Q-,H-,R-}
{$I-,Q-,H-,R-,V-}
{ needed for insert,delete,readln }
{$ifdef OPENSTRINGS}
{$P+}
{$endif}
{ Stack check gives a note under linux }
{$ifndef linux}
@ -432,7 +437,10 @@ const
{
$Log$
Revision 1.43 1998-11-26 23:16:13 jonas
Revision 1.44 1998-11-27 14:50:57 peter
+ open strings, $P switch support
Revision 1.43 1998/11/26 23:16:13 jonas
* changed RandSeed and OldRandSeed to Cardinal to avoid negative random numbers
Revision 1.42 1998/11/24 17:12:43 peter

25
rtl/inc/text.inc
View File

@ -726,8 +726,15 @@ Begin
End;
{$ifdef OPENSTRINGS}
Procedure Read_String(var f : TextRec;var s : String);[Public,Alias:{$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_STRING'];
{$else}
Procedure Read_String(Maxlen : Longint;var f : TextRec;var s : String);[Public,Alias:{$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_STRING'];
{$endif}
var
{$ifdef OPENSTRINGS}
maxlen,
{$endif}
sPos,len : Longint;
p,startp,maxp : pchar;
Begin
@ -743,6 +750,9 @@ Begin
end;
{ Read maximal until Maxlen is reached }
sPos:=0;
{$ifdef OPENSTRINGS}
MaxLen:=high(s);
{$endif}
repeat
If f.BufPos>=f.BufEnd Then
begin
@ -902,15 +912,23 @@ Begin
End;
Procedure Read_String(Maxlen : Longint;var f : TextRec;var s : AnsiString);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_ANSISTRING'];
{$ifdef OPENSTRINGS}
Procedure Read_AnsiString(var f : TextRec;var s : AnsiString);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_ANSISTRING'];
{$else}
Procedure Read_AnsiString(Maxlen : Longint;var f : TextRec;var s : AnsiString);[Public,Alias: {$ifdef FPCNAMES}'FPC_'+{$endif}'READ_TEXT_ANSISTRING'];
{$endif}
var
p,maxp,startp,sidx : PChar;
{$ifdef OPENSTRINGS}
maxlen,
{$endif}
spos,len : longint;
Begin
{ Delete the string }
Decr_ansi_ref (Pointer(S));
{ We assign room for 1024 characters totally at random.... }
Pointer(s):=Pointer(NewAnsiString(1024));
MaxLen:=1024;
{ Check error and if file is open }
If (InOutRes<>0) then
exit;
@ -1194,7 +1212,10 @@ end;
{
$Log$
Revision 1.34 1998-11-16 12:21:48 peter
Revision 1.35 1998-11-27 14:50:58 peter
+ open strings, $P switch support
Revision 1.34 1998/11/16 12:21:48 peter
* fixes for 0.99.8
Revision 1.33 1998/10/23 00:03:29 peter