paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-13 08:59:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

* patch by Alexander Shishkin to clean up $ifopt usage by $push/$pop, resolves #20346

Browse Source 
git-svn-id: trunk@19256 -
This commit is contained in:
florian 2011-09-27 20:22:40 +00:00
parent 02b0ef5379
commit d7f7a9bb76
86 changed files with 462 additions and 632 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
compiler/assemble.pas
View File

@ -316,9 +316,9 @@ Implementation
hs:=s;
if hs[length(hs)] in ['/','\'] then
delete(hs,length(hs),1);
{$I-}
{$push} {$I-}
mkdir(hs);
{$I+}
{$pop}
if ioresult<>0 then;
end;
end;
@ -401,9 +401,9 @@ Implementation
else
begin
assign(g,AsmFileName);
{$I-}
{$push} {$I-}
erase(g);
{$I+}
{$pop}
if ioresult<>0 then;
end;
end;
@ -440,9 +440,9 @@ Implementation
if outcnt>0 then
begin
{ suppress i/o error }
{$i-}
{$push} {$I-}
BlockWrite(outfile,outbuf,outcnt);
{$i+}
{$pop}
ioerror:=ioerror or (ioresult<>0);
outcnt:=0;
end;
@ -574,9 +574,9 @@ Implementation
{$endif}
begin
Assign(outfile,AsmFileName);
{$I-}
{$push} {$I-}
Rewrite(outfile,1);
{$I+}
{$pop}
if ioresult<>0 then
begin
ioerror:=true;
@ -608,9 +608,9 @@ Implementation
if ppufilename<>'' then
begin
Assign(f,ppufilename);
{$I-}
{$push} {$I-}
reset(f,1);
{$I+}
{$pop}
if ioresult=0 then
begin
FileAge := FileGetDate(GetFileHandle(f));

4
compiler/ccharset.pas
View File

@ -84,9 +84,9 @@ unit ccharset;
datasize:=256;
getmem(data,sizeof(tunicodecharmapping)*datasize);
assign(t,f);
{$I-}
{$push}{$I-}
reset(t);
{$I+}
{$pop}
if ioresult<>0 then
begin
freemem(data,sizeof(tunicodecharmapping)*datasize);

4
compiler/cfileutl.pas
View File

@ -684,9 +684,9 @@ end;
begin
if d[length(d)]=source_info.DirSep then
Delete(d,length(d),1);
{$I-}
{$push}{$I-}
rmdir(d);
{$I+}
{$pop}
RemoveDir:=(ioresult=0);
end;

4
compiler/cmsgs.pas
View File

@ -188,9 +188,9 @@ begin
getmem(buf,bufsize);
{ Read the message file }
assign(f,fn);
{$I-}
{$push}{$I-}
reset(f);
{$I+}
{$pop}
if ioresult<>0 then
begin
WriteLn('*** PPC, can not open message file ',fn);

44
compiler/constexp.pas
View File

@ -173,9 +173,9 @@ begin
if sspace>=b then
begin
result.signed:=true;
{$Q-}
{$push} {$Q-}
result.svalue:=a.svalue+int64(b);
{$ifdef ena_q}{$Q+}{$endif}
{$pop}
exit;
end;
@ -190,9 +190,9 @@ try_qword:
if uspace>=b then
begin
result.signed:=false;
{$Q-}
{$push} {$Q-}
result.uvalue:=a.uvalue+b;
{$ifdef ena_q}{$Q+}{$endif}
{$pop}
exit;
end;
result.overflow:=true;
@ -211,9 +211,9 @@ begin
{Try if the result fits in an int64.}
if (a.signed) and (a.svalue<0) then
{$Q-}
{$push} {$Q-}
sspace:=qword(a.svalue)+abs_low_int64
{$ifdef ena_q}{$Q+}{$endif}
{$pop}
else if not a.signed and (a.uvalue>qword(high(int64))) then
goto try_qword
else
@ -221,9 +221,9 @@ begin
if sspace>=b then
begin
result.signed:=true;
{$Q-}
{$push} {$Q-}
result.svalue:=a.svalue-int64(b);
{$ifdef ena_q}{$Q+}{$endif}
{$pop}
exit;
end;
@ -232,9 +232,9 @@ try_qword:
if not(a.signed and (a.svalue<0)) and (a.uvalue>=b) then
begin
result.signed:=false;
{$Q-}
{$push} {$Q-}
result.uvalue:=a.uvalue-b;
{$ifdef ena_q}{$Q+}{$endif}
{$pop}
exit;
end;
ov:
@ -250,9 +250,9 @@ begin
exit;
end;
if b.signed and (b.svalue<0) then
{$Q-}
{$push} {$Q-}
result:=sub_from(a,qword(-b.svalue))
{$ifdef ena_q}{$Q+}{$endif}
{$pop}
else
result:=add_to(a,b.uvalue);
end;
@ -266,9 +266,9 @@ begin
exit;
end;
if b.signed and (b.svalue<0) then
{$Q-}
{$push} {$Q-}
result:=add_to(a,qword(-b.svalue))
{$ifdef ena_q}{$Q+}{$endif}
{$pop}
else
result:=sub_from(a,b.uvalue);
end;
@ -345,16 +345,16 @@ begin
result.overflow:=false;
sa:=a.signed and (a.svalue<0);
if sa then
{$Q-}
{$push} {$Q-}
aa:=qword(-a.svalue)
{$ifdef ena_q}{$Q+}{$endif}
{$pop}
else
aa:=a.uvalue;
sb:=b.signed and (b.svalue<0);
if sb then
{$Q-}
{$push} {$Q-}
bb:=qword(-b.svalue)
{$ifdef ena_q}{$Q+}{$endif}
{$pop}
else
bb:=b.uvalue;
@ -393,16 +393,16 @@ begin
result.overflow:=false;
sa:=a.signed and (a.svalue<0);
if sa then
{$Q-}
{$push} {$Q-}
aa:=qword(-a.svalue)
{$ifdef ena_q}{$Q+}{$endif}
{$pop}
else
aa:=a.uvalue;
sb:=b.signed and (b.svalue<0);
if sb then
{$Q-}
{$push} {$Q-}
bb:=qword(-b.svalue)
{$ifdef ena_q}{$Q+}{$endif}
{$pop}
else
bb:=b.uvalue;
if bb=0 then

4
compiler/cresstr.pas
View File

@ -229,9 +229,9 @@ uses
ResFileName:=ChangeFileExt(current_module.ppufilename^,'.rst');
message1 (general_i_writingresourcefile,ExtractFileName(ResFileName));
Assign(F,ResFileName);
{$i-}
{$push}{$i-}
Rewrite(f);
{$i+}
{$pop}
If IOresult<>0 then
begin
message1(general_e_errorwritingresourcefile,ResFileName);

20
compiler/cstreams.pas
View File

@ -371,9 +371,9 @@ begin
If Mode=fmcreate then
begin
system.assign(FHandle,AFileName);
{$I-}
{$push} {$I-}
system.rewrite(FHandle,1);
{$I+}
{$pop}
CStreamError:=IOResult;
end
else
@ -381,9 +381,9 @@ begin
oldfilemode:=filemode;
filemode:=$40 or Mode;
system.assign(FHandle,AFileName);
{$I-}
{$push} {$I-}
system.reset(FHandle,1);
{$I+}
{$pop}
CStreamError:=IOResult;
filemode:=oldfilemode;
end;
@ -392,9 +392,9 @@ end;
destructor TCFileStream.Destroy;
begin
{$I-}
{$push} {$I-}
System.Close(FHandle);
{$I+}
{$pop}
CStreamError:=IOResult;
end;
@ -417,10 +417,10 @@ end;
Procedure TCFileStream.SetSize(NewSize: Longint);
begin
{$I-}
{$push} {$I-}
System.Seek(FHandle,NewSize);
System.Truncate(FHandle);
{$I+}
{$pop}
CStreamError:=IOResult;
end;
@ -429,7 +429,7 @@ function TCFileStream.Seek(Offset: Longint; Origin: Word): Longint;
var
l : longint;
begin
{$I-}
{$push} {$I-}
case Origin of
soFromBeginning :
begin
@ -451,7 +451,7 @@ begin
System.Seek(FHandle,l);
end;
end;
{$I+}
{$pop}
CStreamError:=IOResult;
Result:=l;
end;

4
compiler/gendef.pas
View File

@ -106,9 +106,9 @@ begin
Exit;
{ open file }
assign(t,fname);
{$I+}
{$push}{$I-}
rewrite(t);
{$I-}
{$pop}
if ioresult<>0 then
exit;
case target_info.system of

18
compiler/i386/daopt386.pas
View File

@ -689,10 +689,8 @@ begin
end;
{$ifdef q+}
{$push}
{$q-}
{$define overflowon}
{$endif q+}
// checks whether a write to r2 of size "size" contains address r1
function refsoverlapping(const r1, r2: treference; size1, size2: tcgsize): boolean;
@ -710,10 +708,7 @@ begin
(r1.relsymbol = r2.relsymbol);
end;
{$ifdef overflowon}
{$q+}
{$undef overflowon}
{$endif overflowon}
{$pop}
function isgp32reg(supreg: tsuperregister): boolean;
@ -1723,10 +1718,8 @@ begin
RefInSequence := TmpResult
end;
{$ifdef q+}
{$push}
{$q-}
{$define overflowon}
{$endif q+}
// checks whether a write to r2 of size "size" contains address r1
function arrayrefsoverlapping(const r1, r2: treference; size1, size2: tcgsize): Boolean;
var
@ -1741,10 +1734,7 @@ begin
(r1.symbol=r2.symbol) and
(r1.base = r2.base)
end;
{$ifdef overflowon}
{$q+}
{$undef overflowon}
{$endif overflowon}
{$pop}
function isSimpleRef(const ref: treference): boolean;
{ returns true if ref is reference to a local or global variable, to a }

12
compiler/impdef.pas
View File

@ -161,9 +161,9 @@ procedure CreateTempDir(const s:string);
end
else
begin
{$I-}
{$push} {$I-}
mkdir(s);
{$I+}
{$pop}
if ioresult<>0 then;
end;
end;
@ -189,9 +189,9 @@ procedure call_ar;
ExecuteProcess(ar_name,'rs '+impname+' '+path+dirsep+'*.swo');
cleardir(path,'*.sw');
cleardir(path,'*.swo');
{$i-}
{$push} {$I-}
RmDir(path);
{$i+}
{$pop}
if ioresult<>0 then;
end;
procedure makeasm(index:cardinal;name:pchar;isData:longbool);
@ -446,11 +446,11 @@ begin
impname:=libname;
lname:=binname;
OldFileMode:=filemode;
{$I-}
{$push} {$I-}
filemode:=0;
reset(f,1);
filemode:=OldFileMode;
{$I+}
{$pop}
if IOResult<>0 then
begin
makedef:=false;

9
compiler/ncgutil.pas
View File

@ -1377,10 +1377,8 @@ implementation
trashintval := trashintvalues[localvartrashing];
case tabstractnormalvarsym(p).initialloc.loc of
LOC_CREGISTER :
{$ifopt q+}
{$define overflowon}
{$push}
{$q-}
{$endif}
begin
{ avoid problems with broken x86 shifts }
case tcgsize2size[tabstractnormalvarsym(p).initialloc.size] of
@ -1399,10 +1397,7 @@ implementation
internalerror(2010060801);
end;
end;
{$ifdef overflowon}
{$undef overflowon}
{$q+}
{$endif}
{$pop}
LOC_REFERENCE :
begin
if ((tsym(p).typ=localvarsym) and

8
compiler/optdead.pas
View File

@ -285,9 +285,9 @@ const
if not result then
exit;
cgmessage1(wpo_error_reading_symbol_file,symbolprogfullpath);
{$i-}
{$push}{$i-}
close(fsymfile);
{$i+}
{$pop}
if fileexists(fsymfilename) then
deletefile(fsymfilename);
end;
@ -389,9 +389,9 @@ const
end;
assign(fsymfile,fsymfilename);
{$i-}
{$push}{$i-}
reset(fsymfile);
{$i+}
{$pop}
if failiferror((ioresult<>0) or eof(fsymfile)) then
exit;
readln(fsymfile, line);

4
compiler/options.pas
View File

@ -1889,9 +1889,9 @@ begin
{ open file }
Message1(option_using_file,filename);
assign(f,ExpandFileName(filename));
{$I-}
{$push}{$I-}
reset(f);
{$I+}
{$pop}
if ioresult<>0 then
begin
Message1(option_unable_open_file,filename);

4
compiler/pmodules.pas
View File

@ -1769,12 +1769,12 @@ implementation
{ rename }
if PPUFn=PPLFn then
begin
{$I-}
{$push}{$I-}
assign(f,PPUFn);
erase(f);
assign(f,'ppumove.$$$');
rename(f,PPUFn);
{$I+}
{$pop}
if ioresult<>0 then;
end;
Result:=True;

9
compiler/ppcgen/aasmcpu.pas
View File

@ -554,15 +554,10 @@ uses cutils, cclasses;
assigned(taicpu(p).oper[0]^.ref^.symbol) and
(taicpu(p).oper[0]^.ref^.symbol is tasmlabel) and
(labelpositions[tasmlabel(taicpu(p).oper[0]^.ref^.symbol).labelnr] <> NIL) and
{$ifopt q+}
{$push}
{$q-}
{$define overflowon}
{$endif}
(ptruint(abs(ptrint(labelpositions[tasmlabel(taicpu(p).oper[0]^.ref^.symbol).labelnr]-instrpos)) - (low(smallint) div 4)) > ptruint((high(smallint) - low(smallint)) div 4)) then
{$ifdef overflowon}
{$q+}
{$undef overflowon}
{$endif}
{$pop}
begin
// add a new label after this jump
current_asmdata.getjumplabel(l);

8
compiler/psub.pas
View File

@ -261,9 +261,9 @@ implementation
procedure printnode_reset;
begin
assign(printnodefile,treelogfilename);
{$I-}
{$push}{$I-}
rewrite(printnodefile);
{$I+}
{$pop}
if ioresult<>0 then
begin
Comment(V_Error,'Error creating '+treelogfilename);
@ -572,11 +572,11 @@ implementation
procedure tcgprocinfo.printproc(pass:string);
begin
assign(printnodefile,treelogfilename);
{$I-}
{$push}{$I-}
append(printnodefile);
if ioresult<>0 then
rewrite(printnodefile);
{$I+}
{$pop}
if ioresult<>0 then
begin
Comment(V_Error,'Error creating '+treelogfilename);

4
compiler/scanner.pas
View File

@ -1837,9 +1837,9 @@ In case not, the value returned can be arbitrary.
begin
{ open outputfile }
assign(f,fn);
{$I-}
{$push}{$I-}
rewrite(f);
{$I+}
{$pop}
if ioresult<>0 then
Comment(V_Fatal,'can''t create file '+fn);
getmem(buf,preprocbufsize);

4
compiler/script.pas
View File

@ -186,7 +186,7 @@ begin
else
le:= source_info.newline;
{$I-}
{$push}{$I-}
Rewrite(t,1);
if ioresult<>0 then
exit;
@ -197,7 +197,7 @@ begin
Blockwrite(t,le[1],length(le),i);
end;
Close(t);
{$I+}
{$pop}
i:=ioresult;
{$ifdef hasUnix}
if executable then

4
compiler/systems/t_embed.pas
View File

@ -799,7 +799,7 @@ function TLinkerEmbedded.postprocessexecutable(const fn : string;isdll:boolean):
postprocessexecutable:=false;
{ open file }
assign(f,fn);
{$I-}
{$push}{$I-}
reset(f,1);
if ioresult<>0 then
Message1(execinfo_f_cant_open_executable,fn);
@ -835,7 +835,7 @@ function TLinkerEmbedded.postprocessexecutable(const fn : string;isdll:boolean):
end;
close(f);
{$I+}
{$pop}
if ioresult<>0 then
;
postprocessexecutable:=true;

4
compiler/systems/t_go32v2.pas
View File

@ -338,7 +338,7 @@ begin
exit;
{ open file }
assign(f,n);
{$I-}
{$push}{$I-}
reset(f,1);
if ioresult<>0 then
Message1(execinfo_f_cant_open_executable,n);
@ -389,7 +389,7 @@ begin
end;
freemem(zerobuf,maxfillsize);
close(f);
{$I+}
{$pop}
i:=ioresult;
postprocessexecutable:=true;
end;

6
compiler/systems/t_win.pas
View File

@ -1674,7 +1674,7 @@ implementation
end;
{ open file }
assign(f,fn);
{$I-}
{$push}{$I-}
reset(f,1);
if ioresult<>0 then
Message1(execinfo_f_cant_open_executable,fn);
@ -1782,9 +1782,9 @@ implementation
end;
freemem(zerobuf,maxfillsize);
close(f);
{$I+}
{$pop}
if ioresult<>0 then;
postprocessexecutable:=true;
postprocessexecutable:=true;
end;

3
compiler/utils/dummyas.pp
View File

@ -84,7 +84,7 @@ begin
halt(1);
end;
Assign(ofile,assembler_name);
{$I-}
{$push}{$I-}
Reset(ofile);
if IOResult<>0 then
begin
@ -108,4 +108,5 @@ begin
Writeln(ofile,'assembler file=',assembler_name);
Writeln(ofile,'object file=',object_name);
Close(ofile);
{$pop}
end.

4
compiler/utils/fixlog.pp
View File

@ -53,9 +53,9 @@ begin
write('processing ',fn,': ');
assign(t,fn);
assign(f,'fixlog.tmp');
{$I-}
{$push}{$I-}
reset(t);
{$I+}
{$pop}
if ioresult<>0 then
begin
writeln('error!');

8
compiler/utils/fixtab.pp
View File

@ -208,14 +208,14 @@ begin
new(inbuf);
new(outbuf);
assign(f,fn);
{$I-}
{$push}{$I-}
reset(f,1);
{$I+}
{$pop}
if ioresult<>0 then
exit;
{$I-}
{$push}{$I-}
rewrite(g,1);
{$I+}
{$pop}
if ioresult<>0 then
begin
close(f);

12
compiler/utils/msg2inc.pp
View File

@ -79,9 +79,9 @@ begin
Writeln('Loading messagefile ',fn);
{Read the message file}
assign(f,fn);
{$I-}
{$push} {$I-}
reset(f);
{$I+}
{$pop}
if ioresult<>0 then
begin
WriteLn('fatal error: '+fn+' not found');
@ -570,9 +570,9 @@ begin
Writeln('Renumbering ',fn);
{Read the message file}
assign(f,fn);
{$I-}
{$push} {$I-}
reset(f);
{$I+}
{$pop}
if ioresult<>0 then
begin
WriteLn('*** message file '+fn+' not found ***');
@ -644,9 +644,9 @@ begin
writeln('Writing TeXfile ',outfn);
{ Open infile }
assign(f,infn);
{$I-}
{$push} {$I-}
reset(f);
{$I+}
{$pop}
if ioresult<>0 then
begin
WriteLn('*** message file '+infn+' not found ***');

8
compiler/utils/ppumove.pp
View File

@ -215,9 +215,9 @@ var
begin
{ create the temp dir first }
fsplit(libfn,d,n,e);
{$I-}
{$push}{$I-}
mkdir(n+'.sl');
{$I+}
{$pop}
if ioresult<>0 then;
{ Extract }
if Shell(arbin+' x '+libfn)<>0 then
@ -429,12 +429,12 @@ begin
{ rename }
if PPUFn=PPLFn then
begin
{$I-}
{$push}{$I-}
assign(f,PPUFn);
erase(f);
assign(f,'ppumove.$$$');
rename(f,PPUFn);
{$I+}
{$pop}
if ioresult<>0 then;
end;
{ the end }

8
compiler/verbose.pas
View File

@ -151,14 +151,14 @@ implementation
close(status.redirfile);
assign(status.redirfile,fn);
{$I-}
{$push}{$I-}
append(status.redirfile);
if ioresult <> 0 then
begin
assign(status.redirfile,fn);
rewrite(status.redirfile);
end;
{$I+}
{$pop}
status.use_redir:=(ioresult=0);
end;
@ -171,11 +171,11 @@ implementation
exit;
fn:='fpcdebug.txt';
assign(status.reportbugfile,fn);
{$I-}
{$push}{$I-}
append(status.reportbugfile);
if ioresult <> 0 then
rewrite(status.reportbugfile);
{$I+}
{$pop}
status.use_bugreport:=(ioresult=0);
if status.use_bugreport then
writeln(status.reportbugfile,'FPC bug report file');

4
compiler/wpobase.pas
View File

@ -600,9 +600,9 @@ implementation
var
i: longint;
begin
{$i-}
{$push}{$i-}
rewrite(foutputfile);
{$i+}
{$pop}
if (ioresult <> 0) then
begin
cgmessage1(wpo_cant_create_feedback_file,ffilename);

8
packages/amunits/src/utilunits/linklist.pas
View File

@ -751,9 +751,9 @@ var
begin
buffer := @buf;
Assign(Inf, thefile);
{$I-}
{$push}{$I-}
Reset(Inf);
{$I+}
{$pop}
if IOResult = 0 then begin
while not eof(Inf) do begin
{ I don't want end of lines here (for use with amiga listviews)
@ -781,9 +781,9 @@ VAR
tempnode : pFPCNode;
begin
Assign(Out, TheFile);
{$I-}
{$push}{$I-}
Rewrite(Out);
{$I+}
{$pop}
if IOResult = 0 then begin
i := NodesInList(thelist);
IF i > 0 THEN BEGIN

4
packages/cdrom/src/cdromlin.inc
View File

@ -94,9 +94,9 @@ Var
begin
Result:=0;
Assign(FSTab,'/etc/fstab');
{$i-}
{$push}{$i-}
Reset(fstab);
{$i+}
{$pop}
If IOResult=0 then
begin
While Not EOF(fstab) do

18
packages/fcl-base/src/contnrs.pp
View File

@ -1143,10 +1143,8 @@ end;
Var
p,pmax : pchar;
begin
{$ifopt Q+}
{$define overflowon}
{$push}
{$Q-}
{$endif}
result:=0;
p:=@s[1];
pmax:=@s[length(s)+1];
@ -1155,20 +1153,15 @@ end;
result:=LongWord(LongInt(result shl 5) - LongInt(result)) xor LongWord(P^);
inc(p);
end;
{$ifdef overflowon}
{$Q+}
{$undef overflowon}
{$endif}
{$pop}
end;
function FPHash(P: PChar; Len: Integer): LongWord;
Var
pmax : pchar;
begin
{$ifopt Q+}
{$define overflowon}
{$push}
{$Q-}
{$endif}
result:=0;
pmax:=p+len;
while (p<pmax) do
@ -1176,10 +1169,7 @@ end;
result:=LongWord(LongInt(result shl 5) - LongInt(result)) xor LongWord(P^);
inc(p);
end;
{$ifdef overflowon}
{$Q+}
{$undef overflowon}
{$endif}
{$pop}
end;

2
packages/fcl-base/src/pooledmm.pp
View File

@ -91,8 +91,6 @@ type
implementation
{$IFOpt R+}{$Define RangeChecksOn}{$Endif}
{ TPooledMemManager }
procedure TPooledMemManager.Clear;

16
packages/fcl-fpcunit/src/digesttestreport.pp
View File

@ -136,14 +136,14 @@ var
t : text;
begin
assign(t,logfile);
{$I-}
{$push}{$I-}
append(t);
{$I+}
{$pop}
if ioresult<>0 then
begin
{$I-}
{$push}{$I-}
rewrite(t);
{$I+}
{$pop}
if ioresult<>0 then
begin
writeln('Can''t append to '+logfile);
@ -179,9 +179,9 @@ begin
{ Try parent first }
mkdirtree(SplitPath(hs));
{ make this dir }
{$I-}
{$push}{$I-}
mkdir(s);
{$I+}
{$pop}
ioresult;
end;
end;
@ -298,9 +298,9 @@ begin
else
begin
getdir(0,OldDir);
{$I-}
{$push}{$I-}
chdir(FOutputDir+'/'+ATestSuite.TestName);
{$I+}
{$pop}
if IOResult<>0 then
begin
mkdirtree(FOutputDir+'/'+ATestSuite.TestName);

20
packages/fcl-net/src/netdb.pp
View File

@ -300,9 +300,9 @@ Var
begin
Result:=Nil;
Assign(F,FileName);
{$I-}
{$push}{$I-}
Reset(F);
{$I+};
{$pop};
If (IOResult<>0) then
Exit;
Try
@ -462,10 +462,10 @@ begin
Result:=0;
ResolveFileName:=Fn;
ResolveFileAge:=FileAge(FN);
{$i-}
{$push}{$i-}
Assign(R,FN);
Reset(R);
{$i+}
{$pop}
If (IOResult<>0) then
exit;
Try
@ -1167,9 +1167,9 @@ begin
If FileExists(SProtocolFile) then
begin
Assign(F,SProtocolFile);
{$i-}
{$push}{$i-}
Reset(F);
{$i+}
{$pop}
If (IOResult=0) then
begin
While Not Result and GetNextProtoEntry(F,HE) do
@ -1269,9 +1269,9 @@ begin
If FileExists(SNetworksFile) then
begin
Assign(F,SNetworksFile);
{$i-}
{$push}{$i-}
Reset(F);
{$i+}
{$pop}
If (IOResult=0) then
begin
While Not Result and GetNextNetworkEntry(F,NE) do
@ -1362,9 +1362,9 @@ begin
If FileExists(SServicesFile) then
begin
Assign(F,SServicesFile);
{$i-}
{$push}{$i-}
Reset(F);
{$i+}
{$pop}
If (IOResult=0) then
begin
While Not Result and GetNextServiceEntry(F,TE) do

5
packages/fcl-xml/src/xmlutils.pp
View File

@ -16,7 +16,6 @@ unit xmlutils;
{$ifdef fpc}{$mode objfpc}{$endif}
{$H+}
{$ifopt Q+}{$define overflow_check}{$endif}
interface
@ -477,9 +476,9 @@ begin
Result := InitValue;
while KeyLen <> 0 do
begin
{$ifdef overflow_check}{$q-}{$endif}
{$push}{$q-}
Result := Result * $F4243 xor ord(Key^);
{$ifdef overflow_check}{$q+}{$endif}
{$pop}
Inc(Key);
Dec(KeyLen);
end;

16
packages/fv/src/stddlg.pas
View File

@ -2132,14 +2132,14 @@ begin
P := FExpand(DirInput^.Data^);
if (Length(P) > 3) and (P[Length(P)] = DirSeparator) then
Dec(P[0]);
{$I-}
{$push}{$I-}
ChDir(P);
if (IOResult <> 0) then
begin
MessageBox(sInvalidDirectory, nil, mfError + mfOkButton);
Valid := False;
end;
{$I+}
{$pop}
end;
end;
@ -2342,7 +2342,7 @@ var
D: Char;
begin
D := GetCurDrive;
{$I-}
{$push}{$I-}
ChDir(Drive+':');
if (IOResult = 0) then
begin
@ -2350,7 +2350,7 @@ begin
ChDir(D+':')
end
else DriveValid := False;
{$I+}
{$pop}
end;
{$else HAS_DOS_DRIVES}
begin
@ -2676,9 +2676,9 @@ var
Dlg : PEditChDirDialog;
Rec : DirStr;
begin
{$I-}
{$push}{$I-}
GetDir(0,Dir);
{$I+}
{$pop}
Rec := FExpand(ADir);
Dlg := New(PEditChDirDialog,Init(cdHelpButton,HistoryID));
if (Application^.ExecuteDialog(Dlg,@Rec) = cmOk) then
@ -2687,9 +2687,9 @@ begin
ADir := Rec;
end
else SelectDir := False;
{$I-}
{$push}{$I-}
ChDir(Dir);
{$I+}
{$pop}
end;
{****************************************************************************}

4
packages/gdbint/examples/symify.pp
View File

@ -32,9 +32,9 @@ var
sym : tsyminfo;
begin
assign(t,fn);
{$I-}
{$push}{$I-}
reset(t);
{$I+}
{$pop}
if ioresult<>0 then
exit;
while not eof(t) do

9
packages/graph/src/go32v2/vesa.inc
View File

@ -1094,15 +1094,10 @@ end;
begin
if TmpFillPattern and j <> 0 then
fill.pat[7-i] := currentColor;
{$ifopt q+}
{$push}
{$q-}
{$define overflowOn}
{$endif}
j := j shl 1;
{$ifdef overflowOn}
{$q+}
{$undef overflowOn}
{$endif}
{$pop}
end;
Repeat
SetWriteBank(smallint(offs shr 16));

8
packages/graph/src/inc/gtext.inc
View File

@ -785,14 +785,10 @@ end;
if (font>DefaultFont) and not assigned(fonts[font].instr) then
begin
assign(f,bgipath+fonts[font].name+'.CHR');
{$ifopt I+}
{$define IOCHECK_WAS_ON}
{$push}
{$i-}
{$endif}
reset(f,1);
{$ifdef IOCHECK_WAS_ON}
{$i+}
{$endif}
{$pop}
if ioresult<>0 then
begin
_graphresult:=grFontNotFound;

8
packages/gtk2/examples/gtk_demo/gtk_demo.pas
View File

@ -59,10 +59,10 @@ const
*)
function file_is_valid (var f: file): boolean;
begin
{$I-}
{$push}{$I-}
if eof(f) then
exit (TRUE);
{$I+}
{$pop}
if IOResult <> 0 then
file_is_valid := FALSE
else
@ -645,10 +645,10 @@ begin
exit;
end;
{$I-}
{$push}{$I-}
assign (f, full_name);
reset (f);
{$I+}
{$pop}
if IOResult <> 0 then
g_print ('Cannot open %s: file not found'#13#10, [full_name]);

4
packages/gtk2/examples/gtk_demo/images.inc
View File

@ -163,10 +163,10 @@ begin
g_error_free (error);
end else
begin
{$I-}
{$push}{$I-}
assign (image_stream, filename);
reset (image_stream, 1);
{$I+}
{$pop}
if IOResult <> 0 then
error_msg := g_strdup_printf ('Error while opening file "%s"',

4
packages/hash/src/md5.pp
View File

@ -534,11 +534,11 @@ begin
MDInit(Context, Version);
Assign(F, Filename);
{$i-}
{$push}{$i-}
ofm := FileMode;
FileMode := 0;
Reset(F, 1);
{$i+}
{$pop}
if IOResult = 0 then
begin

4
packages/hash/src/sha1.pp
View File

@ -254,11 +254,11 @@ begin
SHA1Init(Context);
Assign(F, Filename);
{$i-}
{$push}{$i-}
ofm := FileMode;
FileMode := 0;
Reset(F, 1);
{$i+}
{$pop}
if IOResult = 0 then
begin

8
packages/hermes/src/hermes_debug.inc
View File

@ -52,14 +52,14 @@ var
F: TextFile;
begin
AssignFile(F, 'debug.txt');
{$I-}
{$push}{$I-}
Append(F);
{$I+}
{$pop}
if IOResult <> 0 then
begin
{$I-}
{$push}{$I-}
Rewrite(F);
{$I+}
{$pop}
if IOResult <> 0 then
exit;
end;

12
packages/ncurses/examples/edit_demo.pp
View File

@ -192,9 +192,9 @@ Begin
End;
If ret = nkEnter Then Begin
Assign(tst,s);
{$I-}
{$push}{$I-}
Reset(tst);
{$I+}
{$pop}
If IoResult = 0 Then Begin
Close(tst);
Assign(f,s);
@ -220,7 +220,7 @@ Begin
ClearLines(hdr);
lines := 0;
win := nShowMessage('Reading "'+fnam+'"...',47,' Open File ',46,false);
{$I-}
{$push}{$I-}
Repeat
If Not Eof(f) Then Begin
Readln(f,s);
@ -229,7 +229,7 @@ Begin
End;
Until Eof(f) or err;
Close(f);
{$I+}
{$pop}
win^.Hide;
win^.Done;
line1 := hdr^.next;
@ -256,7 +256,7 @@ Begin
Assign(tmp,tnam);
Assign(f,fnam);
win := nShowMessage('Saving "'+fnam+'"...',47,' Save File ',46,false);
{$I-}
{$push}{$I-}
Reset(tmp);
If IoResult = 0 Then Begin
Close(tmp);
@ -271,7 +271,7 @@ Begin
cur := cur^.next;
Until cur = hdr;
Close(f);
{$I+}
{$pop}
win^.Hide;
win^.Done;
End;

12
packages/pasjpeg/examples/cjpeg.pas
View File

@ -653,9 +653,9 @@ begin
if (file_index < argc) then
begin
Assign(input_file, ParamStr(file_index));
{$I-}
{$push}{$I-}
Reset(input_file, 1);
{$ifdef IOcheck} {$I+} {$endif}
{$pop}
if (IOresult <> 0) then
begin
WriteLn(output, progname, ': can''t open ', ParamStr(file_index));
@ -672,9 +672,9 @@ begin
if (outfilename <> '') then
begin
Assign(output_file, outfilename);
{$I-}
{$push}{$I-}
Reset(output_file, 1);
{$ifdef IOcheck} {$I+} {$endif}
{$pop}
if (IOresult = 0) then
begin
WriteLn(output, outfilename, ': already exists.');
@ -682,9 +682,9 @@ begin
Halt(EXIT_FAILURE);
end;
{$I-}
{$push}{$I-}
ReWrite(output_file, 1);
{$ifdef IOcheck} {$I+} {$endif}
{$pop}
if (IOresult <> 0) then
begin
WriteLn(output, progname, ': can''t create ', outfilename);

12
packages/pasjpeg/examples/djpeg.pas
View File

@ -302,9 +302,9 @@ begin
begin { too expensive to do twice! }
{$ifdef QUANT_2PASS_SUPPORTED} { otherwise can't quantize to supplied map }
assign(mapfile, ParamStr(argn));
{$I-}
{$push}{$I-}
reset(mapfile, 1);
{$IFDEF IoCheck} {$I+} {$ENDIF}
{$pop}
if (IOresult <> 0) then
begin
WriteLn(output, progname, ': can''t open ', ParamStr(argn));
@ -584,9 +584,9 @@ begin
if (file_index < argc) then
begin
assign(input_file, ParamStr(file_index));
{$I-}
{$push}{$I-}
Reset(input_file, 1);
{$I+}
{$pop}
if (IOresult <> 0) then
begin
WriteLn(output, progname, ': can''t open ', ParamStr(file_index));
@ -604,9 +604,9 @@ begin
if (outfilename <> '') then
begin
assign(output_file, outfilename);
{$I-}
{$push}{$I-}
rewrite(output_file, 1);
{$I+}
{$pop}
if (IOresult <> 0) then
begin
WriteLn(output, progname, ': can''t open ', outfilename);

10
packages/pasjpeg/examples/example.pas
View File

@ -37,8 +37,6 @@ function read_JPEG_file (filename : string) : boolean;
implementation
{$IFOPT I+} {$DEFINE IoCheck} {$ENDIF}
{ <setjmp.h> is used for the optional error recovery mechanism shown in
the second part of the example. }
@ -121,9 +119,9 @@ begin
requires it in order to write binary files. }
Assign(outfile, filename);
{$I-}
{$push}{$I-}
ReWrite(outfile, 1);
{$IFDEF IoCheck} {$I+} {$ENDIF}
{$pop}
if (IOresult <> 0) then
begin
WriteLn(output, 'can''t open ', filename);
@ -334,9 +332,9 @@ begin
requires it in order to read binary files. }
Assign(infile, filename);
{$I-}
{$push}{$I-}
Reset(infile, 1);
{$IFDEF IoCheck} {$I+} {$ENDIF}
{$pop}
if (IOresult <> 0) then
begin
WriteLn(output, 'can''t open ', filename);

8
packages/pasjpeg/examples/fcache.pas
View File

@ -66,10 +66,10 @@ begin
if TFileRec(f).Mode <> fmClosed then
{$ENDIF}
begin
{$IFOPT I+} {$DEFINE IOCheck} {$I-} {$ENDIF}
{$PUSH} {$I-}
Seek(f, FPos);
BlockRead(f, Buffer, BufMemSize, BufSize);
{$IFDEF IOCheck} {$I+} {$ENDIF}
{$POP}
if (IOResult = 0) and (BufSize <> 0) then
active := true;
end;
@ -105,10 +105,10 @@ Begin
with fc do
if active then
begin
{$I-}
{$push}{$I-}
Seek(FVarPtr^, FileOfs);
BlockRead(FVarPtr^, Buffer, BufMemSize, BufSize);
{$IFDEF IOCheck} {$I+} {$ENDIF}
{$pop}
BufPos := 0;
active := (IOResult = 0) and (BufSize <> 0);
end;

8
packages/pasjpeg/examples/jpegtran.pas
View File

@ -528,9 +528,9 @@ begin
if (file_index < ParamCount) then
begin
assign(input_file, ParamStr(file_index));
{$I-}
{$push}{$I-}
reset(input_file, 1);
{$IFDEF IoCheck} {$I+} {$ENDIF}
{$pop}
if (IOresult <> 0) then
begin
WriteLn(output, progname, ': can''t open ', ParamStr(file_index));
@ -548,9 +548,9 @@ begin
if (outfilename <> '') then
begin
assign(output_file, outfilename);
{$I-}
{$push}{$I-}
rewrite(output_file, 1);
{$IFDEF IoCheck} {$I+} {$ENDIF}
{$pop}
if (IOresult <> 0) then
begin
WriteLn(output, progname, ': can''t open ', outfilename);

8
packages/pasjpeg/examples/rdswitch.pas
View File

@ -163,9 +163,9 @@ var
table : array[0..DCTSIZE2-1] of uInt;
begin
Assign(f, filename);
{$I-}
{$push}{$I-}
Reset(f, 1);
{$IFDEF IoCheck} {$I+} {$ENDIF}
{$pop}
if (IOresult <> 0) then
begin
WriteLn(output, 'Can''t open table file ', filename);
@ -287,9 +287,9 @@ var
scans : array[0..MAX_SCANS-1] of jpeg_scan_info;
begin
Assign(f,filename);
{$I-}
{$push}{$I-}
Reset(f, 1);
{$IFDEF IoCheck} {$I+} {$ENDIF}
{$pop}
if (IOresult <> 0) then
begin
WriteLn('Can''t open scan definition file ', filename);

4
packages/pasjpeg/src/jmemdos.pas
View File

@ -176,9 +176,9 @@ begin
fname := prefix + 'JPG' + suffix + '.TMP';
{ Probe to see if file name is already in use }
system.assign(tfile, fname);
{$ifdef IoCheck} {$I-} {$endif}
{$push} {$I-}
system.reset(tfile, 1);
{$ifdef IoCheck} {$I+} {$endif}
{$pop}
if (IOresult <> 0) then
begin
fname := fname + #0;

22
packages/paszlib/examples/minigzip.pas
View File

@ -58,9 +58,9 @@ begin
while true do begin
{$I-}
{$push}{$I-}
blockread (infile, buf, BUFLEN, len);
{$I+}
{$pop}
ioerr := IOResult;
if (ioerr <> 0) then begin
writeln ('read error: ',ioerr);
@ -101,17 +101,17 @@ begin
if (len = 0)
then break;
{$I-}
{$push}{$I-}
blockwrite (outfile, buf, len, written);
{$I+}
{$pop}
if (written <> len)
then error ('write error');
end; {WHILE}
{$I-}
{$push}{$I-}
close (outfile);
{$I+}
{$pop}
ioerr := IOResult;
if (ioerr <> 0) then begin
writeln ('close error: ',ioerr);
@ -138,9 +138,9 @@ var
outname : string;
begin
Assign (infile, filename);
{$I-}
{$push}{$I-}
Reset (infile,1);
{$I+}
{$pop}
ioerr := IOResult;
if (ioerr <> 0) then begin
writeln ('open error: ',ioerr);
@ -193,9 +193,9 @@ begin
end;
Assign (outfile, outname);
{$I-}
{$push}{$I-}
Rewrite (outfile,1);
{$I+}
{$pop}
ioerr := IOResult;
if (ioerr <> 0) then begin
writeln ('open error: ',ioerr);
@ -245,4 +245,4 @@ begin
if (uncompr = true)
then file_uncompress (ParamStr(ParamCount))
else file_compress (ParamStr(ParamCount), outmode);
end.
end.

32
packages/paszlib/src/gzio.pas
View File

@ -219,7 +219,7 @@ begin
s^.stream.avail_out := Z_BUFSIZE;
{$IFOPT I+} {$I-} {$define IOcheck} {$ENDIF}
{$PUSH} {$I-}
Assign (s^.gzfile, path);
{$ifdef unix}
exists:=not (fpstat(path,info)<0);
@ -241,7 +241,7 @@ begin
doseek:=true; // seek AFTER I/O check.
end;
{$IFDEF IOCheck} {$I+} {$ENDIF}
{$POP}
if (IOResult <> 0) then begin
destroy(s);
gzopen := gzFile(nil);
@ -329,9 +329,9 @@ begin
end;
if s^.stream.avail_in=0 then begin
{$I-}
{$push}{$I-}
blockread (s^.gzfile, s^.inbuf^, Z_BUFSIZE, s^.stream.avail_in);
{$I+}
{$pop}
if s^.stream.avail_in=0 then begin
s^.z_eof := true;
if (IOResult <> 0) then s^.z_err := Z_ERRNO;
@ -513,9 +513,9 @@ begin
end;
if s^.path <> '' then begin
{$I-}
{$push}{$I-}
close(s^.gzfile);
{$I+}
{$pop}
if (IOResult <> 0) then destroy := Z_ERRNO;
end;
@ -606,9 +606,9 @@ begin
end; { IF transparent }
if (s^.stream.avail_in = 0) and (s^.z_eof = false) then begin
{$I-}
{$push}{$I-}
blockread (s^.gzfile, s^.inbuf^, Z_BUFSIZE, s^.stream.avail_in);
{$I+}
{$pop}
if (s^.stream.avail_in = 0) then begin
s^.z_eof := true;
if (IOResult <> 0) then begin
@ -878,9 +878,9 @@ begin
len := Z_BUFSIZE - s^.stream.avail_out;
if (len <> 0) then begin
{$I-}
{$push}{$I-}
blockwrite(s^.gzfile, s^.outbuf^, len, written);
{$I+}
{$pop}
if (written <> len) then begin
s^.z_err := Z_ERRNO;
do_flush := Z_ERRNO;
@ -963,17 +963,17 @@ begin
s^.stream.next_in := s^.inbuf;
if (s^.startpos = 0) then begin { not a compressed file }
{$I-}
{$push}{$I-}
seek (s^.gzfile, 0);
{$I+}
{$pop}
gzrewind := 0;
exit;
end;
inflateReset(s^.stream);
{$I-}
{$push}{$I-}
seek (s^.gzfile, s^.startpos);
{$I+}
{$pop}
gzrewind := integer(IOResult);
exit;
end;
@ -1050,9 +1050,9 @@ begin
if (s^.transparent = true) then begin
s^.stream.avail_in := 0;
s^.stream.next_in := s^.inbuf;
{$I-}
{$push}{$I-}
seek (s^.gzfile, offset);
{$I+}
{$pop}
if (IOResult <> 0) then begin
gzseek := z_off_t(-1);
exit;

4
packages/paszlib/src/trees.pas
View File

@ -906,9 +906,9 @@ var
i : integer;
begin
system.assign(header, 'trees.inc');
{$I-}
{$push}{$I-}
ReWrite(header);
{$I+}
{$pop}
Assert (IOresult <> 0, 'Can''t open trees.h');
WriteLn(header,
'{ header created automatically with -DGEN_TREES_H }'^M);

8
packages/paszlib/src/zdeflate.pas
View File

@ -1260,9 +1260,9 @@ distances are limited to MAX_DIST instead of WSIZE. }
scan_end := Pwordarray(scan)^[best_len-1]; { fix }
{$else}
strend := Pbyte(@(s.window^[s.strstart + MAX_MATCH]));
{$IFOPT R+} {$R-} {$DEFINE NoRangeCheck} {$ENDIF}
{$push} {$R-}
scan_end1 := Pbytearray(scan)^[best_len-1];
{$IFDEF NoRangeCheck} {$R+} {$UNDEF NoRangeCheck} {$ENDIF}
{$pop}
scan_end := Pbytearray(scan)^[best_len];
{$endif}
@ -1402,14 +1402,14 @@ distances are limited to MAX_DIST instead of WSIZE. }
best_len := len;
if (len >= nice_match) then
break;
{$PUSH} {$R-}
{$push} {$R-}
{$ifdef UNALIGNED_OK}
scan_end := Pbytearray(scan)^[best_len-1];
{$else}
scan_end1 := Pbytearray(scan)^[best_len-1];
scan_end := Pbytearray(scan)^[best_len];
{$endif}
{$POP}
{$pop}
end;
nextstep:
cur_match := prev^[cur_match and wmask];

15
packages/paszlib/src/ziputils.pas
View File

@ -188,7 +188,7 @@ begin
GetMem(fp, SizeOf(file));
Assign(fp^, filename);
{$i-}
{$push}{$i-}
Case mode of
fopenread:
begin
@ -208,6 +208,7 @@ begin
end;
end;
FileMode := OldFileMode;
{$pop}
if IOresult<>0 then
begin
FreeMem(fp, SizeOf(file));
@ -221,8 +222,9 @@ procedure fclose(fp : FILEptr);
begin
if Assigned(fp) then
begin
{$i-}
{$push}{$i-}
system.close(fp^);
{$pop}
if IOresult=0 then;
FreeMem(fp, SizeOf(file));
end;
@ -238,12 +240,13 @@ begin
if Assigned(buf) then
begin
totalSize := recCount * LongInt(recSize);
{$i-}
{$push}{$i-}
system.BlockRead(fp^, buf^, totalSize, readcount);
if (readcount <> totalSize) then
fread := readcount div recSize
else
fread := recCount;
{$pop}
end
else
fread := 0;
@ -259,12 +262,13 @@ begin
if Assigned(buf) then
begin
totalSize := recCount * LongInt(recSize);
{$i-}
{$push}{$i-}
system.BlockWrite(fp^, buf^, totalSize, written);
if (written <> totalSize) then
fwrite := written div recSize
else
fwrite := recCount;
{$pop}
end
else
fwrite := 0;
@ -274,12 +278,13 @@ function fseek(fp : FILEptr;
recPos : LongInt;
mode : seek_mode) : longint;
begin
{$i-}
{$push}{$i-}
case mode of
SEEK_SET : system.Seek(fp^, recPos);
SEEK_CUR : system.Seek(fp^, FilePos(fp^)+recPos);
SEEK_END : system.Seek(fp^, FileSize(fp^)-1-recPos); { ?? check }
end;
{$pop}
fseek := IOresult; { = 0 for success }
end;

8
packages/ptc/src/core/consolei.inc
View File

@ -126,16 +126,16 @@ var
S: string;
begin
AssignFile(F, AFile);
{$I-}
{$push}{$I-}
Reset(F);
{$I+}
{$pop}
if IOResult <> 0 then
exit;
while not EoF(F) do
begin
{$I-}
{$push}{$I-}
Readln(F, S);
{$I+}
{$pop}
if IOResult <> 0 then
Break;
Option(S);

8
packages/ptc/src/dos/cga/cgaconsolei.inc
View File

@ -86,16 +86,16 @@ var
begin
AssignFile(F, AFileName);
{$I-}
{$push}{$I-}
Reset(F);
{$I+}
{$pop}
if IOResult <> 0 then
exit;
while not EoF(F) do
begin
{$I-}
{$push}{$I-}
Readln(F, S);
{$I+}
{$pop}
if IOResult <> 0 then
Break;
Option(S);

8
packages/ptc/src/dos/textfx2/textfx2consolei.inc
View File

@ -93,16 +93,16 @@ var
begin
AssignFile(F, AFileName);
{$I-}
{$push}{$I-}
Reset(F);
{$I+}
{$pop}
if IOResult <> 0 then
exit;
while not EoF(F) do
begin
{$I-}
{$push}{$I-}
Readln(F, S);
{$I+}
{$pop}
if IOResult <> 0 then
Break;
Option(S);

8
packages/ptc/src/dos/vesa/vesaconsolei.inc
View File

@ -239,16 +239,16 @@ var
S: string;
begin
AssignFile(F, AFileName);
{$I-}
{$push}{$I-}
Reset(F);
{$I+}
{$pop}
if IOResult <> 0 then
exit;
while not EoF(F) do
begin
{$I-}
{$push}{$I-}
Readln(F, S);
{$I+}
{$pop}
if IOResult <> 0 then
Break;
Option(S);

8
packages/ptc/src/dos/vga/vgaconsolei.inc
View File

@ -107,16 +107,16 @@ var
begin
AssignFile(F, AFileName);
{$I-}
{$push}{$I-}
Reset(F);
{$I+}
{$pop}
if IOResult <> 0 then
exit;
while not EoF(F) do
begin
{$I-}
{$push}{$I-}
Readln(F, S);
{$I+}
{$pop}
if IOResult <> 0 then
Break;
Option(S);

8
packages/ptc/src/win32/directx/directxconsolei.inc
View File

@ -145,16 +145,16 @@ var
S: string;
begin
AssignFile(F, AFileName);
{$I-}
{$push}{$I-}
Reset(F);
{$I+}
{$pop}
if IOResult <> 0 then
exit;
while not EoF(F) do
begin
{$I-}
{$push}{$I-}
Readln(F, S);
{$I+}
{$pop}
if IOResult <> 0 then
Break;
Option(S);

8
packages/ptc/src/win32/gdi/gdiconsolei.inc
View File

@ -344,16 +344,16 @@ var
S: string;
begin
AssignFile(F, AFileName);
{$I-}
{$push}{$I-}
Reset(F);
{$I+}
{$pop}
if IOResult <> 0 then
exit;
while not EoF(F) do
begin
{$I-}
{$push}{$I-}
Readln(F, S);
{$I+}
{$pop}
if IOResult <> 0 then
Break;
Option(S);

8
packages/ptc/src/wince/gapi/wincegapiconsolei.inc
View File

@ -346,16 +346,16 @@ var
begin
AssignFile(F, AFileName);
{$I-}
{$push}{$I-}
Reset(F);
{$I+}
{$pop}
if IOResult <> 0 then
exit;
while not EoF(F) do
begin
{$I-}
{$push}{$I-}
Readln(F, S);
{$I+}
{$pop}
if IOResult <> 0 then
Break;
Option(S);

8
packages/ptc/src/wince/gdi/wincegdiconsolei.inc
View File

@ -331,16 +331,16 @@ var
begin
AssignFile(F, AFileName);
{$I-}
{$push}{$I-}
Reset(F);
{$I+}
{$pop}
if IOResult <> 0 then
exit;
while not EoF(F) do
begin
{$I-}
{$push}{$I-}
Readln(F, S);
{$I+}
{$pop}
if IOResult <> 0 then
Break;
Option(S);

8
packages/ptc/src/x11/x11consolei.inc
View File

@ -68,16 +68,16 @@ var
S: string;
begin
AssignFile(F, AFileName);
{$I-}
{$push}{$I-}
Reset(F);
{$I+}
{$pop}
if IOResult <> 0 then
exit;
while not EoF(F) do
begin
{$I-}
{$push}{$I-}
Readln(F, S);
{$I+}
{$pop}
if IOResult <> 0 then
Break;
Option(S);

148
packages/unzip/src/unzip51g.pp
View File

@ -534,9 +534,9 @@ BEGIN
readpos := sizeof ( inbuf ); {Simulates reading -> no blocking}
zipeof := TRUE
END ELSE BEGIN
{$I-}
{$push} {$I-}
blockread ( infile, inbuf, sizeof ( inbuf ), readpos );
{$I+}
{$pop}
IF ( ioresult <> 0 ) OR ( readpos = 0 ) THEN BEGIN {readpos=0: kein Fehler gemeldet!!!}
readpos := sizeof ( inbuf ); {Simulates reading -> CRC error}
zipeof := TRUE;
@ -659,9 +659,9 @@ FUNCTION flush ( w : word ) : boolean;
VAR n : nword; {True wenn OK}
b : boolean;
BEGIN
{$I-}
{$push} {$I-}
blockwrite ( outfile, slide [ 0 ], w, n );
{$I+}
{$pop}
b := ( n = w ) AND ( ioresult = 0 ); {True-> alles ok}
UpdateCRC ( iobuf ( pointer ( @slide [ 0 ] ) ^ ), w );
{--}
@ -1326,9 +1326,9 @@ BEGIN
WHILE ( reachedsize < compsize ) AND NOT totalabort DO BEGIN
readin := compsize -reachedsize;
IF readin > wsize THEN readin := wsize;
{$I-}
{$push} {$I-}
blockread ( infile, slide [ 0 ], readin, outcnt ); {Use slide as buffer}
{$I+}
{$pop}
IF ( outcnt <> readin ) OR ( ioresult <> 0 ) THEN BEGIN
copystored := unzip_ReadErr;
exit
@ -2024,9 +2024,9 @@ VAR
n : nword;
b : boolean;
BEGIN
{$I-}
{$push} {$I-}
blockwrite ( outfile, writebuf^ [ 0 ], write_ptr, n );
{$I+}
{$pop}
b := ( n = write_ptr ) AND ( ioresult = 0 ); {True-> alles ok}
UpdateCRC ( iobuf ( pointer ( @writebuf^ [ 0 ] ) ^ ), write_ptr );
{--}
@ -2243,9 +2243,9 @@ BEGIN
assign ( infile, in_name );
storefilemode := filemode;
filemode := 0;
{$I-}
{$push} {$I-}
reset ( infile, 1 );
{$I+}
{$pop}
filemode := storefilemode;
IF ioresult <> 0 THEN BEGIN
freemem ( slide, wsize );
@ -2253,9 +2253,9 @@ BEGIN
inuse := FALSE;
exit
END;
{$I-}
{$push} {$I-}
seek ( infile, offset ); {seek to header position}
{$I+}
{$pop}
IF ioresult <> 0 THEN BEGIN
freemem ( slide, wsize );
close ( infile );
@ -2264,9 +2264,9 @@ BEGIN
exit
END;
header := @inbuf;
{$I-}
{$push} {$I-}
blockread ( infile, header^, sizeof ( header^ ) ); {read in local header}
{$I+}
{$pop}
IF ioresult <> 0 THEN BEGIN
freemem ( slide, wsize );
close ( infile );
@ -2316,16 +2316,16 @@ BEGIN
seek ( infile, offset );
assign ( outfile, out_name );
{$I-}
{$push} {$I-}
rewrite ( outfile, 1 );
{$I+}
{$pop}
err := ioresult;
{create directories not yet in path}
isadir := ( out_name [ strlen ( out_name ) -1 ] in ['/','\'] );
IF ( err = 3 ) OR isadir THEN BEGIN {path not found}
{$I-}
{$push} {$I-}
getdir ( 0, oldcurdir );
{$I+}
{$pop}
err := ioresult;
strcopy ( buf, out_name );
p1 := strrscan ( buf, DirSep );
@ -2335,27 +2335,27 @@ BEGIN
IF ( p <> NIL ) AND ( p [ 1 ] = ':' ) THEN BEGIN
strcopy ( buf0, 'c:\' ); {set drive}
buf0 [ 0 ] := p [ 0 ];
{$I-}
{$push} {$I-}
chdir ( buf0 );
{$I+}
{$pop}
err := ioresult;
p := strtok ( NIL, '\' );
END;
{$endif}
WHILE ( p <> NIL ) AND ( p <> p1 ) DO BEGIN
{$I-}
{$push} {$I-}
chdir ( strpas ( p ) );
{$I+}
{$pop}
err := ioresult;
IF err <> 0 THEN BEGIN
{$I-}
{$push} {$I-}
mkdir ( strpas ( p ) );
{$I+}
{$pop}
err := ioresult;
IF err = 0 THEN
{$I-}
{$push} {$I-}
chdir ( strpas ( p ) );
{$I+}
{$pop}
err := ioresult;
END;
IF err = 0 THEN
@ -2363,9 +2363,9 @@ BEGIN
ELSE
p := NIL;
END;
{$I-}
{$push} {$I-}
chdir ( oldcurdir );
{$I+}
{$pop}
err := ioresult;
IF isadir THEN BEGIN
freemem ( slide, wsize );
@ -2374,9 +2374,9 @@ BEGIN
inuse := FALSE;
exit;
END;
{$I-}
{$push} {$I-}
rewrite ( outfile, 1 );
{$I+}
{$pop}
err := ioresult;
END;
@ -2508,9 +2508,9 @@ BEGIN
THEN BEGIN {Read over end of header}
move ( buf^ [ bufsize + 1 ], f, extra ); {Restore file}
move ( buf^ [ localstart ], buf^ [ 0 ], bufsize -localstart ); {Move end to beginning in buffer}
{$I-}
{$push} {$I-}
blockread ( f, buf^ [ bufsize -localstart ], localstart, err ); {Read in full central dir, up to maxbufsize Bytes}
{$I+}
{$pop}
IF ( ioresult <> 0 ) OR ( err + localstart < sizeof ( theader ) ) THEN BEGIN
filloutrec := unzip_nomoreitems;
exit
@ -2580,9 +2580,9 @@ BEGIN
WITH zprec DO BEGIN
assign ( f, zipfilename );
filemode := 0; {Others may read or write};
{$I-}
{$push} {$I-}
reset ( f, 1 );
{$I+}
{$pop}
IF ioresult <> 0 THEN BEGIN
GetFirstInZip := unzip_FileError;
exit
@ -2590,9 +2590,9 @@ BEGIN
size := filesize ( f );
IF size = 0 THEN BEGIN
GetFirstInZip := unzip_FileError;
{$I-}
{$push} {$I-}
close ( f );
{$I+}
{$pop}
exit
END;
bufsize := 4096; {in 4k-blocks}
@ -2607,28 +2607,28 @@ BEGIN
{Search from back of file to central directory start}
start := -1; {Nothing found}
REPEAT
{$I-}
{$push} {$I-}
seek ( f, bufstart );
{$I+}
{$pop}
IF ioresult <> 0 THEN BEGIN
GetFirstInZip := unzip_FileError;
freeMem ( buf, bufsize + 1 );
buf := NIL;
{$I-}
{$push} {$I-}
close ( f );
{$I+}
{$pop}
exit
END;
{$I-}
{$push} {$I-}
blockread ( f, buf^, bufsize, err );
{$I+}
{$pop}
IF ( ioresult <> 0 ) OR ( err <> bufsize ) THEN BEGIN
GetFirstInZip := unzip_FileError;
freeMem ( buf, bufsize + 1 );
buf := NIL;
{$I-}
{$push} {$I-}
close ( f );
{$I+}
{$pop}
exit
END;
@ -2651,9 +2651,9 @@ BEGIN
GetFirstInZip := unzip_FileError;
freeMem ( buf, bufsize + 1 );
buf := NIL;
{$I-}
{$push} {$I-}
close ( f );
{$I+}
{$pop}
exit
END;
mainh := pmainheader ( @buf^ [ start -bufstart ] );
@ -2663,9 +2663,9 @@ BEGIN
IF ( localstart + sizeof ( theader ) > start ) THEN BEGIN
buf := NIL;
GetFirstInZip := unzip_InternalError;
{$I-}
{$push} {$I-}
close ( f );
{$I+}
{$pop}
exit
END;
bufstart := headerstart;
@ -2678,32 +2678,32 @@ BEGIN
extra := 0
END;
getmem ( buf, bufsize + 1 + extra );
{$I-}
{$push} {$I-}
seek ( f, bufstart );
{$I+}
{$pop}
IF ioresult <> 0 THEN BEGIN
GetFirstInZip := unzip_FileError;
freeMem ( buf, bufsize + 1 + extra );
buf := NIL;
{$I-}
{$push} {$I-}
close ( f );
{$I+}
{$pop}
exit
END;
{$I-}
{$push} {$I-}
blockread ( f, buf^, bufsize, err ); {Read in full central dir, up to maxbufsize Bytes}
{$I+}
{$pop}
IF ioresult <> 0 THEN BEGIN
GetFirstInZip := unzip_FileError;
freeMem ( buf, bufsize + 1 + extra );
buf := NIL;
{$I-}
{$push} {$I-}
close ( f );
{$I+}
{$pop}
exit
END;
IF extra = 0 THEN
{$I-} close ( f ) {$I+}
{$push} {$I-} close ( f ) {$pop}
ELSE move ( f, buf^ [ bufsize + 1 ], extra ); {Save file info!}
err := filloutRec ( zprec );
IF err <> unzip_ok THEN BEGIN
@ -2741,9 +2741,9 @@ VAR
BEGIN
filemode := 0;
{$I-}
{$push} {$I-}
getdir ( 0, oldcurdir );
{$I+}
{$pop}
err := ioresult;
isZip := FALSE;
IF ( strscan ( filename, '.' ) <> NIL )
@ -2751,33 +2751,33 @@ BEGIN
strcopy ( myname, filename );
l := strlen ( myname );
IF myname [ l -1 ] = DirSep THEN myname [ l -1 ] := #0;
{$I-}
{$push} {$I-}
chdir ( Strpas ( myname ) );
{$I+}
{$pop}
IF ioresult <> 0 THEN BEGIN
assign ( f, Strpas ( myname ) );
filemode := 0; {Others may read or write};
{$I-}
{$push} {$I-}
reset ( f, 1 );
{$I+}
{$pop}
IF ioresult = 0 THEN BEGIN
{$I-}
{$push} {$I-}
blockread ( f, buf, 4, err );
{$I+}
{$pop}
IF ( ioresult = 0 ) THEN BEGIN
IF ( err = 4 ) AND ( buf [ 0 ] = 'P' ) AND ( buf [ 1 ] = 'K' )
AND ( buf [ 2 ] = #3 ) AND ( buf [ 3 ] = #4 ) THEN isZip := TRUE
END;
{$I-}
{$push} {$I-}
close ( f );
{$I+}
{$pop}
err := ioresult; {only clears ioresult variable}
END;
END;
END;
{$I-}
{$push} {$I-}
chdir ( oldcurdir );
{$I+}
{$pop}
err := ioresult;
END;
@ -2792,9 +2792,9 @@ BEGIN
IF ( bufsize = maxbufsize ) THEN BEGIN {Caution: header bigger than 64k!}
extra := sizeof ( file );
move ( buf^ [ bufsize + 1 ], f, extra ); {Restore file}
{$I-}
{$push} {$I-}
close ( f );
{$I+}
{$pop}
IF ioresult <> 0 THEN ;
END ELSE extra := 0;
freemem ( buf, bufsize + 1 + extra );
@ -2816,12 +2816,12 @@ BEGIN
i := filemode;
filemode := 0;
assign ( f, fname );
{$i-}
{$push} {$I-}
Reset ( f, 1 );
filemode := i;
FileExists := ioresult = 0;
Close ( f ); IF ioresult <> 0 THEN;
{$i+}
{$pop}
END;
{$endif Delphi}
@ -3121,7 +3121,7 @@ BEGIN
System.Assign ( f, StrPas ( SourceZipFile ) );
count := filemode;
filemode := 0;
{$i-}
{$push} {$I-}
Reset ( f, 1 );
filemode := count;
IF ioresult <> 0 THEN exit;

9
packages/utmp/src/utmp.pp
View File

@ -277,15 +277,10 @@ var
begin
System.Assign(F, Utmp_file);
{$IFOPT I+}
{$DEFINE I_was_on}
{$ENDIF}
{$push}
{$I-}
System.Reset(F,1);
{$IFDEF I_was_on}
{$UNDEF I_was_on}
{$I+}
{$ENDIF}
{$pop}
UL := User_list;
while UL <> nil do begin
User_list := UL;

4
packages/xforms/examples/colbrowser.pp
View File

@ -100,9 +100,9 @@ var buf : string;
begin
assign (infile,fname);
{$i-}
{$push}{$i-}
reset(infile);
{$i+}
{$pop}
if ioresult<>0 then
begin
fname:=fname+#0;

8
packages/xforms/src/fd2pascal.pp
View File

@ -251,9 +251,9 @@ begin
if pos('.fd',FileName)=0 then
FileName:=FileName+'.fd';
assign(infile,Filename);
{$i-}
{$push}{$i-}
reset (infile);
{$i+}
{$pop}
if ioresult<>0 then
begin
EmitError('Can''t open : '+filename);
@ -509,9 +509,9 @@ begin
end;
assign(outfile,filename);
{$i-}
{$push}{$i-}
rewrite(outfile);
{$i+}
{$pop}
if ioresult<>0 then
begin
EmitError('Couldn''t open output file : '+filename);

9
rtl/go32v2/sysutils.pp
View File

@ -310,10 +310,7 @@ begin
drive:=ord(dir[1])-ord('A')+1
else
drive:=ord(dir[1])-ord('a')+1;
{$undef OPT_I}
{$ifopt I+}
{$define OPT_I}
{$endif}
{$push}
{$I-}
StoredIORes:=InOutRes;
InOutRes:=0;
@ -325,9 +322,7 @@ begin
exit;
end;
end;
{$ifdef OPT_I}
{$I+}
{$endif}
{$pop}
if (Length (Dir) > 1) and
(Dir [Length (Dir)] in AllowDirectorySeparators) and
(* Do not remove '\' after ':' (root directory of a drive)

12
rtl/inc/astrings.inc
View File

@ -595,15 +595,13 @@ begin
len := length(src);
if len > arraysize then
len := arraysize;
{$r-}
{$push}{$r-}
{ make sure we don't try to access element 1 of the ansistring if it's nil }
if len > 0 then
move(src[1],fpc_ansistr_to_chararray[0],len);
{ fpc_big_chararray is defined as array[0..0], see compproc.inc why }
fillchar(fpc_ansistr_to_chararray[len],arraysize-len,0);
{$ifdef RangeCheckWasOn}
{$r+}
{$endif}
{$pop}
end;
{$else ndef FPC_STRTOCHARARRAYPROC}
@ -615,15 +613,13 @@ begin
len := length(src);
if len > length(res) then
len := length(res);
{$r-}
{$push}{$r-}
{ make sure we don't try to access element 1 of the ansistring if it's nil }
if len > 0 then
move(src[1],res[0],len);
{ fpc_big_chararray is defined as array[0..0], see compproc.inc why }
fillchar(res[len],length(res)-len,0);
{$ifdef RangeCheckWasOn}
{$r+}
{$endif}
{$pop}
end;
{$endif ndef FPC_STRTOCHARARRAYPROC}

12
rtl/inc/generic.inc
View File

@ -1212,14 +1212,12 @@ begin
len := length(src);
if len > arraysize then
len := arraysize;
{$r-}
{$push}{$r-}
{ make sure we don't access char 1 if length is 0 (JM) }
if len > 0 then
move(src[1],fpc_shortstr_to_chararray[0],len);
fillchar(fpc_shortstr_to_chararray[len],arraysize-len,0);
{$ifdef RangeCheckWasOn}
{$r+}
{$endif}
{$pop}
end;
{$else ndef FPC_STRTOCHARARRAYPROC}
@ -1231,14 +1229,12 @@ begin
len := length(src);
if len > length(res) then
len := length(res);
{$r-}
{$push}{$r-}
{ make sure we don't access char 1 if length is 0 (JM) }
if len > 0 then
move(src[1],res[0],len);
fillchar(res[len],length(res)-len,0);
{$ifdef RangeCheckWasOn}
{$r+}
{$endif}
{$pop}
end;
{$endif ndef FPC_STRTOCHARARRAYPROC}

27
rtl/inc/objects.pp
View File

@ -1249,10 +1249,8 @@ END;
{ TDosStream OBJECT METHODS }
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{$IFOPT I+}
{$DEFINE IO_CHECK_ON}
{$PUSH}
{$I-}
{$ENDIF}
{--TDosStream---------------------------------------------------------------}
{ Init -> Platforms DOS/DPMI/WIN/OS2 - Checked 16May96 LdB }
@ -1657,10 +1655,7 @@ BEGIN
End;
END;
{$IFDEF IO_CHECK_ON}
{$UNDEF IO_CHECK_ON}
{$I+}
{$ENDIF}
{$POP} //{$i-} for TDosStream, TBufStream
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{ TMemoryStream OBJECT METHODS }
@ -1902,10 +1897,8 @@ END;
{ LastThat -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
{---------------------------------------------------------------------------}
{$IFOPT W-}
{$DEFINE STACKFRAME_OFF}
{$PUSH}
{$W+}
{$ENDIF}
FUNCTION TCollection.LastThat (Test: Pointer): Pointer;
VAR I: LongInt;
@ -1939,10 +1932,7 @@ BEGIN
FirstThat := Nil; { None passed test }
END;
{$IFDEF STACKFRAME_OFF}
{$UNDEF STACKFRAME_OFF}
{$W-}
{$ENDIF}
{$POP}
{--TCollection--------------------------------------------------------------}
{ Pack -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
@ -2046,20 +2036,15 @@ END;
{ ForEach -> Platforms DOS/DPMI/WIN/OS2 - Checked 22May96 LdB }
{---------------------------------------------------------------------------}
{$IFOPT W-}
{$DEFINE STACKFRAME_OFF}
{$PUSH}
{$W+}
{$ENDIF}
PROCEDURE TCollection.ForEach (Action: Pointer);
VAR I: LongInt;
BEGIN
For I := 1 To Count Do { Up from first item }
CallPointerLocal(Action,get_caller_frame(get_frame),Items^[I-1]); { Call with each item }
END;
{$IFDEF STACKFRAME_OFF}
{$UNDEF STACKFRAME_OFF}
{$W-}
{$ENDIF}
{$POP}
{--TCollection--------------------------------------------------------------}

8
rtl/inc/sstrings.inc
View File

@ -489,9 +489,9 @@ begin
end;
{ temporarily disable range checking because of the access to the array[0..0]
member of Tenum_ord_to_string_lookup }
{$PUSH}{$R-}
{$push}{$R-}
res:=enum_o2s^.lookup_data[ordinal];
{$POP}
{$pop}
if (not assigned(res)) then
exit;
s:=res^;
@ -504,7 +504,7 @@ begin
l:=0;
{ temporarily disable range checking because of the access to the array[0..0]
member of Tenum_ord_to_string_search }
{$PUSH}{$R-}
{$push}{$R-}
h:=enum_o2s^.num_entries-1;
repeat
m:=(l+h) div 2;
@ -517,7 +517,7 @@ begin
if l>h then
exit; { Ordinal value not found? Exit }
until false;
{$POP}
{$pop}
s:=sorted_data[m].name^;
end;

33
rtl/inc/system.inc
View File

@ -629,20 +629,10 @@ End;
{$ifopt R+}
{$define RangeCheckWasOn}
{$push}
{$R-}
{$endif opt R+}
{$ifopt I+}
{$define IOCheckWasOn}
{$I-}
{$endif opt I+}
{$ifopt Q+}
{$define OverflowCheckWasOn}
{$Q-}
{$endif opt Q+}
{*****************************************************************************
Miscellaneous
@ -728,9 +718,7 @@ end;
{$IFNDEF NO_GENERIC_STACK_CHECK}
{$IFOPT S+}
{$DEFINE STACKCHECK}
{$ENDIF}
{$PUSH}
{$S-}
procedure fpc_stackcheck(stack_size:SizeUInt);[public,alias:'FPC_STACKCHECK'];
var
@ -749,10 +737,7 @@ begin
HandleError(202);
end;
end;
{$IFDEF STACKCHECK}
{$S+}
{$ENDIF}
{$UNDEF STACKCHECK}
{$POP}
{$ENDIF NO_GENERIC_STACK_CHECK}
@ -1300,17 +1285,7 @@ end;
{$i setjump.inc}
{$ifdef IOCheckWasOn}
{$I+}
{$endif}
{$ifdef RangeCheckWasOn}
{$R+}
{$endif}
{$ifdef OverflowCheckWasOn}
{$Q+}
{$endif}
{$pop} //{$I-,R-,Q-} before 'procedure fpc_rangeerror'
{*****************************************************************************

58
rtl/inc/ustrings.inc
View File

@ -1085,12 +1085,11 @@ begin
len := length(temp);
if len > arraysize then
len := arraysize;
{$push}
{$r-}
move(temp[1],fpc_unicodestr_to_chararray[0],len);
fillchar(fpc_unicodestr_to_chararray[len],arraysize-len,0);
{$ifdef RangeCheckWasOn}
{$r+}
{$endif}
{$pop}
end;
@ -1103,14 +1102,13 @@ begin
len := length(src);
if len > arraysize then
len := arraysize;
{$push}
{$r-}
{ make sure we don't try to access element 1 of the ansistring if it's nil }
if len > 0 then
move(src[1],fpc_unicodestr_to_unicodechararray[0],len*SizeOf(UnicodeChar));
fillchar(fpc_unicodestr_to_unicodechararray[len],(arraysize-len)*SizeOf(UnicodeChar),0);
{$ifdef RangeCheckWasOn}
{$r+}
{$endif}
{$pop}
end;
@ -1128,13 +1126,11 @@ begin
len := length(temp);
if len > arraysize then
len := arraysize;
{$push}
{$r-}
move(temp[1],fpc_ansistr_to_unicodechararray[0],len*sizeof(unicodechar));
fillchar(fpc_ansistr_to_unicodechararray[len],(arraysize-len)*SizeOf(UnicodeChar),0);
{$ifdef RangeCheckWasOn}
{$r+}
{$endif}
{$pop}
end;
function fpc_shortstr_to_unicodechararray(arraysize: SizeInt; const src: ShortString): fpc_big_unicodechararray;[public,alias: 'FPC_SHORTSTR_TO_UNICODECHARARRAY']; compilerproc;
@ -1149,12 +1145,11 @@ begin
len := length(temp);
if len > arraysize then
len := arraysize;
{$push}
{$r-}
move(temp[1],fpc_shortstr_to_unicodechararray[0],len*sizeof(unicodechar));
fillchar(fpc_shortstr_to_unicodechararray[len],(arraysize-len)*SizeOf(UnicodeChar),0);
{$ifdef RangeCheckWasOn}
{$r+}
{$endif}
{$pop}
end;
{$else ndef FPC_STRTOCHARARRAYPROC}
@ -1171,12 +1166,11 @@ begin
len := length(temp);
if len > length(res) then
len := length(res);
{$push}
{$r-}
move(temp[1],res[0],len);
fillchar(res[len],length(res)-len,0);
{$ifdef RangeCheckWasOn}
{$r+}
{$endif}
{$pop}
end;
@ -1187,14 +1181,13 @@ begin
len := length(src);
if len > length(res) then
len := length(res);
{$push}
{$r-}
{ make sure we don't try to access element 1 of the ansistring if it's nil }
if len > 0 then
move(src[1],res[0],len*SizeOf(UnicodeChar));
fillchar(res[len],(length(res)-len)*SizeOf(UnicodeChar),0);
{$ifdef RangeCheckWasOn}
{$r+}
{$endif}
{$pop}
end;
@ -1210,13 +1203,11 @@ begin
len := length(temp);
if len > length(res) then
len := length(res);
{$push}
{$r-}
move(temp[1],res[0],len*sizeof(unicodechar));
fillchar(res[len],(length(res)-len)*SizeOf(UnicodeChar),0);
{$ifdef RangeCheckWasOn}
{$r+}
{$endif}
{$pop}
end;
procedure fpc_shortstr_to_unicodechararray(out res: array of unicodechar; const src: ShortString); compilerproc;
@ -1231,12 +1222,11 @@ begin
len := length(temp);
if len > length(res) then
len := length(res);
{$push}
{$r-}
move(temp[1],res[0],len*sizeof(unicodechar));
fillchar(res[len],(length(res)-len)*SizeOf(UnicodeChar),0);
{$ifdef RangeCheckWasOn}
{$r+}
{$endif}
{$pop}
end;
procedure fpc_ansistr_to_widechararray(out res: array of widechar; const src: RawByteString); compilerproc;
@ -1251,13 +1241,11 @@ begin
len := length(temp);
if len > length(res) then
len := length(res);
{$push}
{$r-}
move(temp[1],res[0],len*sizeof(widechar));
fillchar(res[len],(length(res)-len)*SizeOf(WideChar),0);
{$ifdef RangeCheckWasOn}
{$r+}
{$endif}
{$pop}
end;
procedure fpc_shortstr_to_widechararray(out res: array of widechar; const src: ShortString); compilerproc;
@ -1272,12 +1260,11 @@ begin
len := length(temp);
if len > length(res) then
len := length(res);
{$push}
{$r-}
move(temp[1],res[0],len*sizeof(widechar));
fillchar(res[len],(length(res)-len)*SizeOf(WideChar),0);
{$ifdef RangeCheckWasOn}
{$r+}
{$endif}
{$pop}
end;
@ -1288,14 +1275,13 @@ begin
len := length(src);
if len > length(res) then
len := length(res);
{$push}
{$r-}
{ make sure we don't try to access element 1 of the widestring if it's nil }
if len > 0 then
move(src[1],res[0],len*SizeOf(WideChar));
fillchar(res[len],(length(res)-len)*SizeOf(WideChar),0);
{$ifdef RangeCheckWasOn}
{$r+}
{$endif}
{$pop}
end;

46
rtl/inc/variants.pp
View File

@ -361,9 +361,6 @@ uses
Math,
VarUtils;
{$IFOPT R-} {$DEFINE RANGECHECKINGOFF} {$ENDIF}
{$IFOPT Q-} {$DEFINE OVERFLOWCHECKINGOFF} {$ENDIF}
var
customvarianttypes : array of TCustomVariantType;
customvarianttypelock : trtlcriticalsection;
@ -437,7 +434,7 @@ type
function AtEnd: Boolean;
end;
{$push}
{$r-}
constructor TVariantArrayIterator.Init(aDims: SizeInt; aBounds : PVarArrayBoundArray);
@ -494,9 +491,7 @@ begin
end;
end;
{$ifndef RANGECHECKINGOFF}
{$r+}
{$endif}
{$pop}// {$r-} for TVariantArrayIterator
destructor TVariantArrayIterator.done;
begin
@ -1433,7 +1428,8 @@ begin
r := VariantToInt64(vr);
Overflow := False;
case OpCode of
{$R+}{$Q+}
{$push}
{$R+}{$Q+}
opAdd..opMultiply,opPower: try
case OpCode of
opAdd : l := l + r;
@ -1449,7 +1445,7 @@ begin
on E: SysUtils.EIntOverflow do
Overflow := True;
end;
{$IFDEF RANGECHECKINGOFF} {$R-} {$ENDIF} {$IFDEF OVERFLOWCHECKINGOFF} {$Q+} {$ENDIF}
{$pop}
opIntDivide : l := l div r;
opModulus : l := l mod r;
opShiftLeft : l := l shl r;
@ -2115,17 +2111,12 @@ begin
try
{ Calculation total number of elements in the array }
cnt:=1;
{$ifopt r+}
{$push}
{ arr^.bounds[] is an array[0..0] }
{$define rangeon}
{$r-}
{$endif}
for i:=0 to arr^.dimcount - 1 do
cnt:=cnt*cardinal(arr^.Bounds[i].ElementCount);
{$ifdef rangeon}
{$undef rangeon}
{$r+}
{$endif}
{$pop}
{ Clearing each element }
for i:=1 to cnt do begin
@ -2579,18 +2570,13 @@ begin
else
p:=src.vArray;
{$ifopt r+}
{$define rangeon}
{$push}
{$r-}
{$endif}
if highbound<p^.Bounds[p^.dimcount-1].LowBound-1 then
VarInvalidArgError;
newbounds.LowBound:=p^.Bounds[p^.dimcount-1].LowBound;
{$ifdef rangon}
{$undef rangeon}
{$r+}
{$endif}
{$pop}
newbounds.ElementCount:=highbound-newbounds.LowBound+1;
VarResultCheck(SafeArrayRedim(p,newbounds));
@ -3161,18 +3147,20 @@ end;
{ Variant copy support }
{$push}
{$warnings off}
procedure VarCopyNoInd(var Dest: Variant; const Source: Variant);
begin
NotSupported('VarCopyNoInd');
end;
{$warnings on}
{$pop}
{****************************************************************************
Variant array support procedures and functions
****************************************************************************}
{$push}
{$r-}
function VarArrayCreate(const Bounds: array of SizeInt; aVarType: TVarType): Variant;
@ -3205,9 +3193,7 @@ function VarArrayCreate(const Bounds: array of SizeInt; aVarType: TVarType): Var
end;
end;
{$ifndef RANGECHECKINGOFF}
{$r+}
{$endif}
{$pop}
function VarArrayCreate(const Bounds: PVarArrayBoundArray; Dims : SizeInt; aVarType: TVarType): Variant;
var
@ -3380,7 +3366,7 @@ function DynArrayGetVariantInfo(p : Pointer; var Dims : sizeint) : sizeint;
inc(Dims);
end;
{$push}
{$r-}
procedure DynArrayToVariant(var V: Variant; const DynArray: Pointer; TypeInfo: Pointer);
@ -3580,9 +3566,7 @@ procedure DynArrayFromVariant(var DynArray: Pointer; const V: Variant; TypeInfo:
FreeMem(vararraybounds);
end;
end;
{$ifndef RANGECHECKINGOFF}
{$r+}
{$endif}
{$pop}//{$r-} for DynArray[From|To]Variant
function FindCustomVariantType(const aVarType: TVarType; out CustomVariantType: TCustomVariantType): Boolean; overload;

30
rtl/inc/wstrings.inc
View File

@ -574,12 +574,11 @@ begin
len := length(temp);
if len > arraysize then
len := arraysize;
{$push}
{$r-}
move(temp[1],fpc_widestr_to_chararray[0],len);
fillchar(fpc_widestr_to_chararray[len],arraysize-len,0);
{$ifdef RangeCheckWasOn}
{$r+}
{$endif}
{$pop}
end;
@ -592,14 +591,13 @@ begin
len := length(src);
if len > arraysize then
len := arraysize;
{$push}
{$r-}
{ make sure we don't try to access element 1 of the ansistring if it's nil }
if len > 0 then
move(src[1],fpc_widestr_to_widechararray[0],len*SizeOf(WideChar));
fillchar(fpc_widestr_to_widechararray[len],(arraysize-len)*SizeOf(WideChar),0);
{$ifdef RangeCheckWasOn}
{$r+}
{$endif}
{$pop}
end;
@ -618,12 +616,11 @@ begin
if len > arraysize then
len := arraysize;
{$push}
{$r-}
move(temp[1],fpc_ansistr_to_widechararray[0],len*sizeof(widechar));
fillchar(fpc_ansistr_to_widechararray[len],(arraysize-len)*SizeOf(WideChar),0);
{$ifdef RangeCheckWasOn}
{$r+}
{$endif}
{$pop}
end;
function fpc_shortstr_to_widechararray(arraysize: SizeInt; const src: ShortString): fpc_big_widechararray;[public,alias: 'FPC_SHORTSTR_TO_WIDECHARARRAY']; compilerproc;
@ -638,12 +635,11 @@ begin
len := length(temp);
if len > arraysize then
len := arraysize;
{$push}
{$r-}
move(temp[1],fpc_shortstr_to_widechararray[0],len*sizeof(widechar));
fillchar(fpc_shortstr_to_widechararray[len],(arraysize-len)*SizeOf(WideChar),0);
{$ifdef RangeCheckWasOn}
{$r+}
{$endif}
{$pop}
end;
{$else ndef FPC_STRTOCHARARRAYPROC}
@ -660,12 +656,11 @@ begin
len := length(temp);
if len > length(res) then
len := length(res);
{$push}
{$r-}
move(temp[1],res[0],len);
fillchar(res[len],length(res)-len,0);
{$ifdef RangeCheckWasOn}
{$r+}
{$endif}
{$pop}
end;
@ -676,14 +671,13 @@ begin
len := length(src);
if len > length(res) then
len := length(res);
{$push}
{$r-}
{ make sure we don't try to access element 1 of the ansistring if it's nil }
if len > 0 then
move(src[1],res[0],len*SizeOf(WideChar));
fillchar(res[len],(length(res)-len)*SizeOf(WideChar),0);
{$ifdef RangeCheckWasOn}
{$r+}
{$endif}
{$pop}
end;

18
rtl/objpas/dateutil.inc
View File

@ -1998,15 +1998,9 @@ end;
Julian and Modified Julian Date conversion support
---------------------------------------------------------------------}
{$ifopt R+}
{$define RangeCheckWasOn}
{$push}
{$R-}
{$endif opt R+}
{$ifopt Q+}
{$define OverflowCheckWasOn}
{$Q-}
{$endif opt Q+}
Function DateTimeToJulianDate(const AValue: TDateTime): Double;
var
@ -2063,15 +2057,7 @@ begin
Result:=TryJulianDateToDateTime(AValue + 2400000.5, ADateTime);
end;
{$ifdef RangeCheckWasOn}
{$R+}
{$undef RangeCheckWasOn}
{$endif}
{$ifdef OverflowCheckWasOn}
{$Q+}
{$undef OverflowCheckWasOn}
{$endif}
{$pop}//{$R-}{$Q-} for Julian conversion functions
{ ---------------------------------------------------------------------
Unix timestamp support.

16
rtl/objpas/math.pp
View File

@ -110,25 +110,13 @@ interface
EqualsValue = 0;
LessThanValue = Low(TValueRelationship);
GreaterThanValue = High(TValueRelationship);
{$ifopt R+}
{$define RangeCheckWasOn}
{$push}
{$R-}
{$endif opt R+}
{$ifopt Q+}
{$define OverflowCheckWasOn}
{$Q-}
{$endif opt Q+}
NaN = 0.0/0.0;
Infinity = 1.0/0.0;
NegInfinity = -1.0/0.0;
{$ifdef RangeCheckWasOn}
{$R+}
{$undef RangeCheckWasOn}
{$endif}
{$ifdef OverflowCheckWasOn}
{$Q+}
{$undef OverflowCheckWasOn}
{$endif}
{$pop}
{ Min/max determination }
function MinIntValue(const Data: array of Integer): Integer;

8
rtl/objpas/sysutils/sysutils.inc
View File

@ -266,10 +266,8 @@
end;
{$ifopt S+}
{$define STACKCHECK_WAS_ON}
{$push}
{$S-}
{$endif OPT S }
Procedure CatchUnhandledException (Obj : TObject; Addr: Pointer; FrameCount: Longint; Frames: PPointer);[public,alias:'FPC_BREAK_UNHANDLED_EXCEPTION'];
Var
Message : String;
@ -403,9 +401,7 @@ begin
Raise EAssertionFailed.Createfmt(SAssertError,[S,Fn,LineNo]) at get_caller_addr(theAddr), get_caller_frame(theAddr);
end;
{$ifdef STACKCHECK_WAS_ON}
{$S+}
{$endif}
{$pop} //{$S-} for Error handling functions
Procedure InitExceptions;
{

3
rtl/objpas/varutils.inc
View File

@ -18,6 +18,7 @@
---------------------------------------------------------------------}
{ we do ugly things with tvararray here }
{$PUSH}
{$RANGECHECKS OFF}
Procedure SetUnlockResult (P : PVarArray; Res : HResult);
@ -792,6 +793,6 @@ begin
else
Result:=psa^.ElementSize;
end;
{$POP}

9
rtl/qnx/dos.inc
View File

@ -132,18 +132,13 @@ begin
exit;
end;
{ otherwise try to open the TIMEZONE file }
{$IFOPT I+}
{$DEFINE IOCHECK_ON}
{$ENDIF}
{$push}
{$I-}
Assign(T, '/etc/TIMEZONE');
Reset(T);
If IOResult <> 0 then
exit;
{$IFDEF IOCHECK_ON}
{$I+}
{$ENDIF}
{$UNDEF IOCHECK_ON}
{$pop}
ReadLn(T,s);
Close(T);
GetTimeZoneString:=s;

18
rtl/solaris/unxfunc.inc
View File

@ -134,9 +134,7 @@ var
begin
GetTimezoneFile:='';
assign(ft,SolarisTimeZoneFile);
{$ifopt I+}
{$define OPT_I}
{$endif}
{$push}
{$I-}
reset(ft);
if IOResult=0 then
@ -147,18 +145,16 @@ begin
p:=pos('#',s);
if p>0 then
s[0]:=chr(p-1);
p:=pos('TZ=',s);
p:=pos('TZ=',s);
if p>0 then
begin
GetTimeZoneFile:=SolarisTimeZoneDir+copy(s,p+3,length(s));
GetTimeZoneFile:=SolarisTimeZoneDir+copy(s,p+3,length(s));
close(ft);
exit;
end;
end;
close(ft);
end;
end;
close(ft);
end;
{$ifdef OPT_I}
{$I+}
{$endif}
{$pop}
end;