paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-09 17:48:46 +02:00
Code Issues Packages Projects Releases Wiki Activity

* synchronized with trunk

Browse Source 
git-svn-id: branches/wasm@46538 -
This commit is contained in:
nickysn 2020-08-21 21:20:41 +00:00
commit 9cc67f4bf8
16 changed files with 159 additions and 331 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
compiler/Makefile
View File

@ -4735,7 +4735,6 @@ $(INSTALL_TARGETS):
$(MAKE) PPC_TARGET=$(subst _exe_install,,$@) CPU_UNITDIR=$(subst _exe_install,,$@) exeinstall
$(SYMLINKINSTALL_TARGETS):
$(MAKE) PPC_TARGET=$(subst _symlink_install,,$@) CPU_UNITDIR=$(subst _symlink_install,,$@) compiler
$(ECHO) "Compiler $(subst _symlink_install,,$@) finished, starting installsymlink"
$(MAKE) PPC_TARGET=$(subst _symlink_install,,$@) CPU_UNITDIR=$(subst _symlink_install,,$@) installsymlink
alltargets: $(ALLTARGETS)
.PHONY: all compiler echotime ppuclean execlean clean distclean
@ -5003,7 +5002,7 @@ extcycle:
$(MAKE) cycle OPT="$(OPT) -n -OG2p3 -glttt -CRriot -dEXTDEBUG" ALLOW_WARNINGS=1
cvstest:
$(MAKE) cycle 'LOCALOPT=-n -Se' 'RTLOPT=-n -Se'
ifeq ($(findstring -dFPC_SOFT_FPUX80,$(OPT)),)
ifeq ($(findstring -dFPC_SOFT_FPUX80,$(LOCALOPT)),)
ifeq ($(OS_SOURCE),win64)
EXCLUDE_80BIT_TARGETS=1
endif
@ -5011,6 +5010,11 @@ ifneq ($(findstring $(CPU_SOURCE),aarch64 arm avr jvm m68k mips mipsel powerpc p
EXCLUDE_80BIT_TARGETS=1
endif
endif
ifndef EXCLUDE_80BIT_TARGETS
FULL_TARGETS=$(filter-out $(PPC_TARGET),$(CYCLETARGETS))
else
FULL_TARGETS=$(filter-out i8086,$(filter-out i386,$(filter-out $(PPC_TARGET),$(CYCLETARGETS))))
endif
full: fullcycle
fullcycle:
$(MAKE) distclean
@ -5020,11 +5024,7 @@ ifdef DOWPOCYCLE
$(MAKE) rtlclean
$(MAKE) rtl 'FPC=$(BASEDIR)/$(EXENAMEPREFIX)$(EXENAME)'
endif
ifndef EXCLUDE_80BIT_TARGETS
$(MAKE) $(filter-out $(PPC_TARGET),$(CYCLETARGETS)) 'FPC=$(BASEDIR)/$(EXENAMEPREFIX)$(EXENAME)'
else
$(MAKE) $(filter-out i8086,$(filter-out i386,$(filter-out $(PPC_TARGET),$(CYCLETARGETS)))) 'FPC=$(BASEDIR)/$(EXENAMEPREFIX)$(EXENAME)'
endif
$(MAKE) $(FULL_TARGETS) 'FPC=$(BASEDIR)/$(EXENAMEPREFIX)$(EXENAME)'
htmldocs:
$(PASDOC) -p -h -o html$(PATHSEP)$(PPC_TARGET) -d fpc -d gdb -d $(PPC_TARGET) -u $(PPC_TARGET) $(PPC_TARGET)$(PATHSEP)*.pas systems$(PATHSEP)*.pas *.pas
.PHONY: quickinstall exeinstall install installsymlink fullinstall fullinstallsymlink
@ -5050,11 +5050,7 @@ endif
$(INSTALLEXE) $(INSTALLEXEFILE) $(PPCCPULOCATION)/$(INSTALLEXEFILE)
endif
fullinstall:
ifndef EXCLUDE_80BIT_TARGETS
$(MAKE) $(addsuffix _exe_install,$(filter-out $(PPC_TARGET),$(CYCLETARGETS)))
else
$(MAKE) $(addsuffix _exe_install,$(filter-out i8086,$(filter-out i386,$(filter-out $(PPC_TARGET),$(CYCLETARGETS)))))
endif
$(MAKE) $(addsuffix _exe_install,$($(FULL_TARGETS)))
$(MAKE) $(addsuffix _all,$(TARGET_DIRS))
$(MAKE) $(addsuffix _install,$(TARGET_DIRS))
auxfilesinstall:
@ -5078,12 +5074,7 @@ ifneq ($(PPCCPULOCATION),$(INSTALL_BINDIR))
ln -sf $(INSTALL_BASEDIR)/$(EXENAME) $(INSTALL_BINDIR)/$(EXENAME)
endif
fullinstallsymlink:
$(ECHO) "Fullinstall finished, starting XXX_symlink_install"
ifndef EXCLUDE_80BIT_TARGETS
$(MAKE) $(addsuffix _symlink_install,$(filter-out $(PPC_TARGET),$(CYCLETARGETS)))
else
$(MAKE) $(addsuffix _symlink_install,$(filter-out i8086,$(filter-out i386,$(filter-out $(PPC_TARGET),$(CYCLETARGETS)))))
endif
$(MAKE) $(addsuffix _symlink_install,$(FULL_TARGETS))
.PHONY: rtl rtlclean rtlinstall
rtl:
$(MAKE) -C $(PACKAGEDIR_RTL) 'OPT=$(RTLOPT)' all

32
compiler/Makefile.fpc
View File

@ -627,7 +627,6 @@ $(INSTALL_TARGETS):
$(SYMLINKINSTALL_TARGETS):
$(MAKE) PPC_TARGET=$(subst _symlink_install,,$@) CPU_UNITDIR=$(subst _symlink_install,,$@) compiler
$(ECHO) "Compiler $(subst _symlink_install,,$@) finished, starting installsymlink"
$(MAKE) PPC_TARGET=$(subst _symlink_install,,$@) CPU_UNITDIR=$(subst _symlink_install,,$@) installsymlink
alltargets: $(ALLTARGETS)
@ -1029,7 +1028,7 @@ cvstest:
# This is also the case for other CPUs that don't support
# 80bit real type.
ifeq ($(findstring -dFPC_SOFT_FPUX80,$(OPT)),)
ifeq ($(findstring -dFPC_SOFT_FPUX80,$(LOCALOPT)),)
ifeq ($(OS_SOURCE),win64)
EXCLUDE_80BIT_TARGETS=1
endif
@ -1039,6 +1038,12 @@ ifneq ($(findstring $(CPU_SOURCE),aarch64 arm avr jvm m68k mips mipsel powerpc p
endif
endif
ifndef EXCLUDE_80BIT_TARGETS
FULL_TARGETS=$(filter-out $(PPC_TARGET),$(CYCLETARGETS))
else
FULL_TARGETS=$(filter-out i8086,$(filter-out i386,$(filter-out $(PPC_TARGET),$(CYCLETARGETS))))
endif
full: fullcycle
fullcycle:
@ -1049,11 +1054,7 @@ ifdef DOWPOCYCLE
$(MAKE) rtlclean
$(MAKE) rtl 'FPC=$(BASEDIR)/$(EXENAMEPREFIX)$(EXENAME)'
endif
ifndef EXCLUDE_80BIT_TARGETS
$(MAKE) $(filter-out $(PPC_TARGET),$(CYCLETARGETS)) 'FPC=$(BASEDIR)/$(EXENAMEPREFIX)$(EXENAME)'
else
$(MAKE) $(filter-out i8086,$(filter-out i386,$(filter-out $(PPC_TARGET),$(CYCLETARGETS)))) 'FPC=$(BASEDIR)/$(EXENAMEPREFIX)$(EXENAME)'
endif
$(MAKE) $(FULL_TARGETS) 'FPC=$(BASEDIR)/$(EXENAMEPREFIX)$(EXENAME)'
#####################################################################
# Docs
@ -1099,13 +1100,9 @@ endif
endif
fullinstall:
ifndef EXCLUDE_80BIT_TARGETS
$(MAKE) $(addsuffix _exe_install,$(filter-out $(PPC_TARGET),$(CYCLETARGETS)))
else
$(MAKE) $(addsuffix _exe_install,$(filter-out i8086,$(filter-out i386,$(filter-out $(PPC_TARGET),$(CYCLETARGETS)))))
endif
$(MAKE) $(addsuffix _all,$(TARGET_DIRS))
$(MAKE) $(addsuffix _install,$(TARGET_DIRS))
$(MAKE) $(addsuffix _exe_install,$($(FULL_TARGETS)))
$(MAKE) $(addsuffix _all,$(TARGET_DIRS))
$(MAKE) $(addsuffix _install,$(TARGET_DIRS))
auxfilesinstall:
ifndef CROSSINSTALL
@ -1135,12 +1132,7 @@ ifneq ($(PPCCPULOCATION),$(INSTALL_BINDIR))
endif
fullinstallsymlink:
$(ECHO) "Fullinstall finished, starting XXX_symlink_install"
ifndef EXCLUDE_80BIT_TARGETS
$(MAKE) $(addsuffix _symlink_install,$(filter-out $(PPC_TARGET),$(CYCLETARGETS)))
else
$(MAKE) $(addsuffix _symlink_install,$(filter-out i8086,$(filter-out i386,$(filter-out $(PPC_TARGET),$(CYCLETARGETS)))))
endif
$(MAKE) $(addsuffix _symlink_install,$(FULL_TARGETS))
#####################################################################

3
compiler/globals.pas
View File

@ -1638,6 +1638,9 @@ implementation
cshared:=false;
rlinkpath:='';
sysrootpath:='';
{$ifdef XTENSA}
idfpath:='';
{$endif XTENSA}
{ Search Paths }
unicodepath:='';

180
compiler/xtensa/racpugas.pas
View File

@ -37,7 +37,6 @@ Unit racpugas;
function is_asmopcode(const s: string):boolean;override;
function is_register(const s:string):boolean;override;
// function is_targetdirective(const s: string): boolean; override;
procedure handleopcode;override;
procedure BuildReference(oper : TXtensaOperand);
procedure BuildOperand(oper : TXtensaOperand);
@ -141,24 +140,12 @@ Unit racpugas;
procedure test_end(require_rbracket : boolean);
begin
if require_rbracket then begin
if not(actasmtoken=AS_RBRACKET) then
begin
do_error;
exit;
end
else
Consume(AS_RBRACKET);
end;
if not(actasmtoken in [AS_SEPARATOR,AS_end]) then
do_error
else
begin
{$IFDEF debugasmreader}
writeln('TEST_end_FINAL_OK. Created the following ref:');
writeln('oper.opr.ref.shiftimm=',oper.opr.ref.shiftimm);
writeln('oper.opr.ref.shiftmode=',ord(oper.opr.ref.shiftmode));
writeln('oper.opr.ref.index=',ord(oper.opr.ref.index));
writeln('oper.opr.ref.base=',ord(oper.opr.ref.base));
writeln('oper.opr.ref.signindex=',ord(oper.opr.ref.signindex));
writeln('oper.opr.ref.addressmode=',ord(oper.opr.ref.addressmode));
@ -168,107 +155,20 @@ Unit racpugas;
end;
procedure read_index_shift(require_rbracket : boolean);
var
shift : aint;
begin
case actasmtoken of
AS_COMMA :
begin
Consume(AS_COMMA);
if not(actasmtoken=AS_ID) then
do_error;
end;
AS_RBRACKET :
if require_rbracket then
test_end(require_rbracket)
else
begin
do_error;
exit;
end;
AS_SEPARATOR,AS_END :
if not require_rbracket then
test_end(false)
else
do_error;
else
begin
do_error;
exit;
end;
end;
end;
procedure read_index(require_rbracket : boolean);
var
recname : string;
o_int,s_int : tcgint;
begin
case actasmtoken of
AS_REGISTER :
begin
oper.opr.ref.index:=actasmregister;
Consume(AS_REGISTER);
read_index_shift(require_rbracket);
exit;
end;
AS_PLUS,AS_MINUS :
begin
if actasmtoken=AS_PLUS then
begin
Consume(AS_PLUS);
end;
if actasmtoken=AS_REGISTER then
begin
oper.opr.ref.index:=actasmregister;
Consume(AS_REGISTER);
read_index_shift(require_rbracket);
exit;
end
else
begin
do_error;
exit;
end;
test_end(require_rbracket);
exit;
end;
AS_HASH : // constant
begin
Consume(AS_HASH);
o_int := BuildConstExpression(false,true);
if (o_int>4095) or (o_int<-4095) then
begin
Message(asmr_e_constant_out_of_bounds);
RecoverConsume(false);
exit;
end
else
begin
inc(oper.opr.ref.offset,o_int);
test_end(require_rbracket);
exit;
end;
end;
AS_ID :
begin
recname := actasmpattern;
Consume(AS_ID);
BuildRecordOffsetSize(recname,o_int,s_int,recname,false);
if (o_int>4095)or(o_int<-4095) then
begin
Message(asmr_e_constant_out_of_bounds);
RecoverConsume(false);
exit;
end
else
begin
inc(oper.opr.ref.offset,o_int);
test_end(require_rbracket);
exit;
end;
inc(oper.opr.ref.offset,o_int);
test_end(require_rbracket);
exit;
end;
AS_AT:
begin
@ -281,19 +181,6 @@ Unit racpugas;
test_end(require_rbracket);
exit;
end;
AS_RBRACKET :
begin
if require_rbracket then
begin
test_end(require_rbracket);
exit;
end
else
begin
do_error; // unexpected rbracket
exit;
end;
end;
AS_SEPARATOR,AS_end :
begin
if not require_rbracket then
@ -316,31 +203,6 @@ Unit racpugas;
end; // case
end;
procedure try_prepostindexed;
begin
Consume(AS_RBRACKET);
case actasmtoken of
AS_COMMA :
begin // post-indexed
Consume(AS_COMMA);
read_index(false);
exit;
end;
AS_NOT :
begin // pre-indexed
Consume(AS_NOT);
test_end(false);
exit;
end;
else
begin
test_end(false);
exit;
end;
end; // case
end;
var
lab : TASMLABEL;
begin
@ -350,11 +212,6 @@ Unit racpugas;
oper.opr.ref.base:=actasmregister;
Consume(AS_REGISTER);
case actasmtoken of
AS_RBRACKET :
begin
try_prepostindexed;
exit;
end;
AS_COMMA :
begin
Consume(AS_COMMA);
@ -369,15 +226,6 @@ Unit racpugas;
end;
end
else
{
if base isn't a register, r15=PC is implied base, so it must be a local label.
pascal constants don't make sense, because implied r15
record offsets probably don't make sense, too (a record offset of code?)
TODO: However, we could make the Stackpointer implied.
}
Begin
case actasmtoken of
AS_ID :
@ -446,6 +294,7 @@ Unit racpugas;
if hasdot and
(not oper.hastype) then
checklocalsubscript(oper.opr.localsym);
oper.opr.localforceref:=true;
inc(oper.opr.localsymofs,l)
end;
OPR_CONSTANT :
@ -969,15 +818,6 @@ Unit racpugas;
symtyp : TAsmsymtype;
begin
case actasmpattern of
'.thumb_set':
begin
consume(AS_TARGET_DIRECTIVE);
BuildConstSymbolExpression(true,false,false, val,symname,symtyp);
Consume(AS_COMMA);
BuildConstSymbolExpression(true,false,false, val,symval,symtyp);
curList.concat(tai_symbolpair.create(spk_thumb_set,symname,symval));
end;
'.code':
begin
consume(AS_TARGET_DIRECTIVE);
@ -986,11 +826,6 @@ Unit racpugas;
Message(asmr_e_invalid_code_value);
curList.concat(tai_directive.create(asd_code,tostr(val)));
end;
'.thumb_func':
begin
consume(AS_TARGET_DIRECTIVE);
curList.concat(tai_directive.create(asd_thumb_func,''));
end
else
inherited HandleTargetDirective;
end;
@ -1005,15 +840,8 @@ Unit racpugas;
BuildOpcode(instr);
if is_calljmp(instr.opcode) then
ConvertCalljmp(instr);
{
instr.AddReferenceSizes;
instr.SetInstructionOpsize;
instr.CheckOperandSizes;
}
instr.ConcatInstruction(curlist);
instr.Free;
// actoppostfix:=PF_None;
// actwideformat:=false;
end;

1
packages/fcl-json/src/jsonscanner.pp
View File

@ -322,7 +322,6 @@ begin
'\' : S:='\';
'/' : S:='/';
'u' : begin
S:='0000';
u2:=0;
For I:=1 to 4 do
begin

4
rtl/inc/dynlib.inc
View File

@ -127,7 +127,7 @@ begin
Result:=GetProcedureAddress(Lib,Procname);
end;
Procedure GetDynLibsManager (Var Manager : TDynLibsManager);
Procedure GetDynLibsManager (Out Manager : TDynLibsManager);
begin
Manager:=CurrentDLM;
end;
@ -138,7 +138,7 @@ begin
end;
Procedure SetDynLibsManager (Const New : TDynLibsManager; Var Old: TDynLibsManager);
Procedure SetDynLibsManager (Const New : TDynLibsManager; Out Old: TDynLibsManager);
begin
Old:=CurrentDLM;
CurrentDLM:=New;

4
rtl/inc/dynlibh.inc
View File

@ -61,7 +61,7 @@ Function GetLoadErrorStr: string;
Function FreeLibrary(Lib : TLibHandle) : Boolean; inline;
Function GetProcAddress(Lib : TlibHandle; const ProcName : AnsiString) : {$ifdef cpui8086}FarPointer{$else}Pointer{$endif}; inline;
Procedure GetDynLibsManager (Var Manager : TDynLibsManager);
Procedure GetDynLibsManager (Out Manager : TDynLibsManager);
Procedure SetDynLibsManager (Const New : TDynLibsManager);
Procedure SetDynLibsManager (Const New : TDynLibsManager; Var Old: TDynLibsManager);
Procedure SetDynLibsManager (Const New : TDynLibsManager; out Old: TDynLibsManager);

6
rtl/inc/thread.inc
View File

@ -224,7 +224,7 @@ begin
end;
{$endif FPC_HAS_FEATURE_UNICODESTRINGS}
procedure InitCriticalSection(var cs : TRTLCriticalSection);
procedure InitCriticalSection(out cs : TRTLCriticalSection);
begin
CurrentTM.InitCriticalSection(cs);
@ -254,14 +254,14 @@ begin
CurrentTM.LeaveCriticalSection(cs);
end;
Function GetThreadManager(Var TM : TThreadManager) : Boolean;
Function GetThreadManager(Out TM : TThreadManager) : Boolean;
begin
TM:=CurrentTM;
Result:=True;
end;
Function SetThreadManager(Const NewTM : TThreadManager; Var OldTM : TThreadManager) : Boolean;
Function SetThreadManager(Const NewTM : TThreadManager; Out OldTM : TThreadManager) : Boolean;
begin
GetThreadManager(OldTM);

6
rtl/inc/threadh.inc
View File

@ -113,8 +113,8 @@ type
*****************************************************************************}
Function GetThreadManager(Var TM : TThreadManager) : Boolean;
Function SetThreadManager(Const NewTM : TThreadManager; Var OldTM : TThreadManager) : Boolean;
Function GetThreadManager(Out TM : TThreadManager) : Boolean;
Function SetThreadManager(Const NewTM : TThreadManager; Out OldTM : TThreadManager) : Boolean;
Function SetThreadManager(Const NewTM : TThreadManager) : Boolean;
{$ifndef DISABLE_NO_THREAD_MANAGER}
{$endif DISABLE_NO_THREAD_MANAGER}
@ -165,7 +165,7 @@ procedure SetThreadDebugName(threadHandle: TThreadID; const ThreadName: UnicodeS
{ this allows to do a lot of things in MT safe way }
{ it is also used to make the heap management }
{ thread safe }
procedure InitCriticalSection(var cs : TRTLCriticalSection);
procedure InitCriticalSection(out cs : TRTLCriticalSection);
procedure DoneCriticalSection(var cs : TRTLCriticalSection);
procedure EnterCriticalSection(var cs : TRTLCriticalSection);
procedure LeaveCriticalSection(var cs : TRTLCriticalSection);

8
rtl/inc/ustringh.inc
View File

@ -156,13 +156,13 @@ function WideStringToUCS4String(const s : WideString) : UCS4String;
function UCS4StringToWideString(const s : UCS4String) : WideString;
{$endif FPC_HAS_FEATURE_DYNARRAYS}
Procedure GetWideStringManager (Var Manager : TUnicodeStringManager);
Procedure GetWideStringManager (Out Manager : TUnicodeStringManager);
Procedure SetWideStringManager (Const New : TUnicodeStringManager);
Procedure SetWideStringManager (Const New : TUnicodeStringManager; Var Old: TUnicodeStringManager);
Procedure SetWideStringManager (Const New : TUnicodeStringManager; Out Old: TUnicodeStringManager);
Procedure GetUnicodeStringManager (Var Manager : TUnicodeStringManager);
Procedure GetUnicodeStringManager (Out Manager : TUnicodeStringManager);
Procedure SetUnicodeStringManager (Const New : TUnicodeStringManager);
Procedure SetUnicodeStringManager (Const New : TUnicodeStringManager; Var Old: TUnicodeStringManager);
Procedure SetUnicodeStringManager (Const New : TUnicodeStringManager; Out Old: TUnicodeStringManager);
function StringElementSize(const S : UnicodeString): Word; overload;
function StringRefCount(const S : UnicodeString): SizeInt; overload;

8
rtl/inc/ustrings.inc
View File

@ -131,13 +131,13 @@ function DefaultGetStandardCodePage(const stdcp: TStandardCodePageEnum): TSystem
Result:=DefaultFileSystemCodePage
end;
Procedure GetUnicodeStringManager (Var Manager : TUnicodeStringManager);
Procedure GetUnicodeStringManager (Out Manager : TUnicodeStringManager);
begin
manager:=widestringmanager;
end;
Procedure SetUnicodeStringManager (Const New : TUnicodeStringManager; Var Old: TUnicodeStringManager);
Procedure SetUnicodeStringManager (Const New : TUnicodeStringManager; Out Old: TUnicodeStringManager);
begin
Old:=widestringmanager;
widestringmanager:=New;
@ -150,13 +150,13 @@ begin
end;
Procedure GetWideStringManager (Var Manager : TUnicodeStringManager);
Procedure GetWideStringManager (out Manager : TUnicodeStringManager);
begin
manager:=widestringmanager;
end;
Procedure SetWideStringManager (Const New : TUnicodeStringManager; Var Old: TUnicodeStringManager);
Procedure SetWideStringManager (Const New : TUnicodeStringManager; Out old: TUnicodeStringManager);
begin
Old:=widestringmanager;
widestringmanager:=New;

2
rtl/inc/variant.inc
View File

@ -1101,7 +1101,7 @@ function Null: Variant; // Null standard constant
Variant manager functions
**********************************************************************}
procedure GetVariantManager(var VarMgr: TVariantManager);
procedure GetVariantManager(out VarMgr: TVariantManager);
begin
VarMgr:=VariantManager;
end;

2
rtl/inc/varianth.inc
View File

@ -214,7 +214,7 @@ type
end;
pvariantmanager = ^tvariantmanager;
procedure GetVariantManager(var VarMgr: TVariantManager);
procedure GetVariantManager(Out VarMgr: TVariantManager);
procedure SetVariantManager(const VarMgr: TVariantManager);
{ Global constants. Needed here only for compatibility. }

163
rtl/objpas/classes/stringl.inc
View File

@ -228,7 +228,6 @@ begin
BreakChars:=[#0,QuoteChar,Delimiter]
else
BreakChars:=[#0..' ',QuoteChar,Delimiter];
// Check for break characters and quote if required.
For i:=0 to count-1 do
begin
@ -242,7 +241,7 @@ begin
inc(p);
DoQuote:=(p<>pchar(S)+length(S));
end;
if DoQuote then
if DoQuote and (QuoteChar<>#0) then
Result:=Result+QuoteString(S,QuoteChar)
else
Result:=Result+S;
@ -547,100 +546,78 @@ var
Add(StringReplace(Copy(AValue,i+1,j-i-1),aQuoteChar+aQuoteChar,aQuoteChar, [rfReplaceAll]));
end;
Function CheckQuoted : Boolean;
{ Paraphrased from Delphi XE2 help:
Strings must be separated by Delimiter characters or spaces.
They may be enclosed in QuoteChars.
QuoteChars in the string must be repeated to distinguish them from the QuoteChars enclosing the string.
}
begin
Result:=(AValue[i]=aQuoteChar) and (aQuoteChar<>#0);
If Not Result then
exit;
// next string is quoted
j:=i+1;
while (j<=len) and
((AValue[j]<>aQuoteChar) or
((j+1<=len) and (AValue[j+1]=aQuoteChar))) do
begin
if (j<=len) and (AValue[j]=aQuoteChar) then
inc(j,2)
else
inc(j);
end;
AddQuoted;
i:=j+1;
end;
Procedure MaybeSkipSpaces; inline;
begin
if Not aStrictDelimiter then
while (i<=len) and (Ord(AValue[i])<=Ord(' ')) do
inc(i);
end;
begin
BeginUpdate;
i:=1;
j:=1;
aNotFirst:=false;
{ Paraphrased from Delphi XE2 help:
Strings must be separated by Delimiter characters or spaces.
They may be enclosed in QuoteChars.
QuoteChars in the string must be repeated to distinguish them from the QuoteChars enclosing the string.
}
try
if DoClear then
Clear;
len:=length(AValue);
If aStrictDelimiter then
begin
while i<=Len do begin
// skip delimiter
if aNotFirst and (i<=len) and (AValue[i]=aDelimiter) then
inc(i);
// read next string
if i<=len then begin
if AValue[i]=aQuoteChar then begin
// next string is quoted
j:=i+1;
while (j<=len) and
((AValue[j]<>aQuoteChar) or
((j+1<=len) and (AValue[j+1]=aQuoteChar))) do
BeginUpdate;
i:=1;
j:=1;
aNotFirst:=false;
try
if DoClear then
Clear;
len:=length(AValue);
while i<=len do
begin
// skip delimiter
if aNotFirst and (i<=len) and (AValue[i]=aDelimiter) then
inc(i);
MaybeSkipSpaces;
// read next string
if i>len then
begin
if (j<=len) and (AValue[j]=aQuoteChar) then
inc(j,2)
else
inc(j);
if aNotFirst then Add('');
end
else
begin
// next string is quoted
if not CheckQuoted then
begin
// next string is not quoted; read until control character/space/delimiter
j:=i;
while (j<=len) and
(aStrictDelimiter or (Ord(AValue[j])>Ord(' '))) and
(AValue[j]<>aDelimiter) do
inc(j);
Add( Copy(AValue,i,j-i));
i:=j;
end;
end;
AddQuoted;
i:=j+1;
end else begin
// next string is not quoted; read until delimiter
j:=i;
while (j<=len) and
(AValue[j]<>aDelimiter) do inc(j);
Add( Copy(AValue,i,j-i));
i:=j;
end;
end else begin
if aNotFirst then Add('');
end;
aNotFirst:=true;
end;
end
else
begin
while i<=len do begin
// skip delimiter
if aNotFirst and (i<=len) and (AValue[i]=aDelimiter) then inc(i);
// skip spaces
while (i<=len) and (Ord(AValue[i])<=Ord(' ')) do inc(i);
// read next string
if i<=len then begin
if AValue[i]=aQuoteChar then begin
// next string is quoted
j:=i+1;
while (j<=len) and
( (AValue[j]<>aQuoteChar) or
( (j+1<=len) and (AValue[j+1]=aQuoteChar) ) ) do begin
if (j<=len) and (AValue[j]=aQuoteChar) then inc(j,2)
else inc(j);
end;
AddQuoted;
i:=j+1;
end else begin
// next string is not quoted; read until control character/space/delimiter
j:=i;
while (j<=len) and
(Ord(AValue[j])>Ord(' ')) and
(AValue[j]<>aDelimiter) do inc(j);
Add( Copy(AValue,i,j-i));
i:=j;
end;
end else begin
if aNotFirst then Add('');
end;
// skip spaces
while (i<=len) and (Ord(AValue[i])<=Ord(' ')) do inc(i);
aNotFirst:=true;
end;
end;
MaybeSkipSpaces;
aNotFirst:=true;
end; // While I<=Len
finally
EndUpdate;
end;

35
rtl/xtensa/setjump.inc
View File

@ -14,12 +14,43 @@
**********************************************************************}
function fpc_setjmp(var S : jmp_buf) : longint;assembler;[Public, alias : 'FPC_SETJMP']; compilerproc;
function fpc_setjmp(var S : jmp_buf) : longint;assembler;[Public, alias : 'FPC_SETJMP']; compilerproc; nostackframe;
{$ifdef fpc_abi_call0}
asm
s32i.n a0,S.a0
s32i.n a1,S.a1
s32i.n a8,S.a8
s32i.n a12,S.a12
s32i.n a13,S.a13
s32i.n a14,S.a14
s32i.n a15,S.a15
movi.n a2,0
end;
{$endif fpc_abi_call0}
{$ifdef fpc_abi_windowed}
asm
movi a2,0
end;
{$endif fpc_abi_windowed}
procedure fpc_longjmp(var S : jmp_buf;value : longint);assembler;[Public, alias : 'FPC_LONGJMP']; compilerproc;
procedure fpc_longjmp(var S : jmp_buf;value : longint);assembler;[Public, alias : 'FPC_LONGJMP']; compilerproc; nostackframe;
{$ifdef fpc_abi_call0}
asm
l32i.n a0,S.a0
l32i.n a1,S.a1
l32i.n a8,S.a8
l32i.n a12,S.a12
l32i.n a13,S.a13
l32i.n a14,S.a14
l32i.n a15,S.a15
movi.n a2,1
movnez a2,value,value
end;
{$endif fpc_abi_call0}
{$ifdef fpc_abi_windowed}
asm
end;
{$endif fpc_abi_windowed}

9
rtl/xtensa/setjumph.inc
View File

@ -15,8 +15,15 @@
**********************************************************************}
type
jmp_buf = packed record
{$ifdef fpc_abi_call0}
jmp_buf = record
a0,a1,a8,a12,a13,a14,a15 : DWord;
end;
{$endif fpc_abi_call0}
{$ifdef fpc_abi_windowed}
jmp_buf = record
end;
{$endif fpc_abi_windowed}
pjmp_buf = ^jmp_buf;
function setjmp(var S : jmp_buf) : longint;[external name 'FPC_SETJMP'];