From 0895ca2f2873d6812aa3f4d6d7a637e13491be6f Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Mon, 13 Aug 2001 12:41:56 +0000 Subject: [PATCH] * made code for str(x,y) completely processor independent --- compiler/i386/n386inl.pas | 12 +++- compiler/ncal.pas | 16 +++++- compiler/ninl.pas | 113 +++++++++++++++++++++++++++++++++++++- 3 files changed, 136 insertions(+), 5 deletions(-) diff --git a/compiler/i386/n386inl.pas b/compiler/i386/n386inl.pas index fb2a015370..952d44a265 100644 --- a/compiler/i386/n386inl.pas +++ b/compiler/i386/n386inl.pas @@ -545,6 +545,7 @@ implementation dummycoll.free; end; +{$ifndef hascompilerproc} procedure handle_str; var @@ -675,6 +676,7 @@ implementation myexit: dummycoll.free; end; +{$endif hascompilerproc} Procedure Handle_Val; @@ -1494,8 +1496,13 @@ implementation handlereadwrite(true,true); in_str_x_string : begin +{$ifndef hascompilerproc} handle_str; maybe_loadself; +{$else not hascompilerproc} + { should be removed in pass 1 (JM) } + internalerror(200108131); +{$endif not hascompilerproc} end; in_val_x : Begin @@ -1693,7 +1700,10 @@ begin end. { $Log$ - Revision 1.16 2001-07-10 18:01:08 peter + Revision 1.17 2001-08-13 12:41:57 jonas + * made code for str(x,y) completely processor independent + + Revision 1.16 2001/07/10 18:01:08 peter * internal length for ansistring and widestrings Revision 1.15 2001/07/08 21:00:18 peter diff --git a/compiler/ncal.pas b/compiler/ncal.pas index 81461da3a1..50030cbb71 100644 --- a/compiler/ncal.pas +++ b/compiler/ncal.pas @@ -543,12 +543,19 @@ implementation constructor tcallnode.createintern(const name: string; params: tnode); var srsym: tsym; + symowner: tsymtable; begin - srsym := searchsymonlyin(systemunit,name); + if not (cs_compilesystem in aktmoduleswitches) then + begin + srsym := searchsymonlyin(systemunit,name); + symowner := systemunit; + end + else + searchsym(name,srsym,symowner); if not assigned(srsym) or (srsym.typ <> procsym) then internalerror(200107271); - self.create(params,tprocsym(srsym),systemunit,nil); + self.create(params,tprocsym(srsym),symowner,nil); end; {$endif hascompilerproc} @@ -1680,7 +1687,10 @@ begin end. { $Log$ - Revision 1.40 2001-08-06 21:40:46 peter + Revision 1.41 2001-08-13 12:41:56 jonas + * made code for str(x,y) completely processor independent + + Revision 1.40 2001/08/06 21:40:46 peter * funcret moved from tprocinfo to tprocdef Revision 1.39 2001/08/01 15:07:29 jonas diff --git a/compiler/ninl.pas b/compiler/ninl.pas index 20380ffec7..d6f979d85d 100644 --- a/compiler/ninl.pas +++ b/compiler/ninl.pas @@ -39,6 +39,10 @@ interface function pass_1 : tnode;override; function det_resulttype:tnode;override; function docompare(p: tnode): boolean; override; +{$ifdef hascompilerproc} + private + function str_pass_1: tnode; +{$endif hascompilerproc} end; var @@ -973,9 +977,13 @@ implementation CGMessage(cg_e_illegal_expression); { we need a var parameter } valid_for_var(tcallparanode(hp).left); +{$ifndef hascompilerproc} + { with compilerproc's, this is not necessary anymore, the callnode } + { will convert it to an openstring itself if necessary (JM) } { generate the high() value for the shortstring } if is_shortstring(tcallparanode(hp).left.resulttype.def) then tcallparanode(hp).gen_high_tree(true); +{$endif not hascompilerproc} { !!!! check length of string } while assigned(tcallparanode(hp).right) do hp:=tcallparanode(hp).right; @@ -1378,6 +1386,102 @@ implementation {$ifdef fpc} {$maxfpuregisters 0} {$endif fpc} + +{$ifdef hascompilerproc} + function tinlinenode.str_pass_1 : tnode; + var + lenpara, + fracpara, + newparas, + dest, + source : tcallparanode; + newnode : tnode; + len, + fraclen : longint; + procname: string; + is_real : boolean; + + begin + { get destination string } + dest := tcallparanode(left); + + { get source para (number) } + source := dest; + while assigned(source.right) do + source := tcallparanode(source.right); + is_real := source.resulttype.def.deftype = floatdef; + + { get len/frac parameters } + lenpara := nil; + fracpara := nil; + if (cpf_is_colon_para in tcallparanode(dest.right).callparaflags) then + begin + lenpara := tcallparanode(dest.right); + if (cpf_is_colon_para in tcallparanode(lenpara.right).callparaflags) then + begin + fracpara := lenpara; + lenpara := tcallparanode(lenpara.right); + end; + end; + + { generate the parameter list for the compilerproc } + newparas := dest; + + { if we have a float parameter, insert the realtype, len and fracpara parameters } + if is_real then + begin + { insert realtype parameter } + newparas.right := ccallparanode.create(cordconstnode.create( + ord(tfloatdef(source.left.resulttype.def).typ),s32bittype),newparas.right); + { if necessary, insert a fraction parameter } + if not assigned(fracpara) then + begin + tcallparanode(newparas.right).right := ccallparanode.create( + cordconstnode.create(-1,s32bittype),tcallparanode(newparas.right).right); + fracpara := tcallparanode(tcallparanode(newparas.right).right); + end; + { if necessary, insert a length para } + if not assigned(lenpara) then + fracpara.right := ccallparanode.create(cordconstnode.create(-32767,s32bittype), + fracpara.right); + end + else + { for a normal parameter, insert a only length parameter if one is missing } + if not assigned(lenpara) then + newparas.right := ccallparanode.create(cordconstnode.create(-1,s32bittype), + newparas.right); + + { remove the parameters from the original node so they won't get disposed, } + { since they're reused } + left := nil; + + { create procedure name } + procname := 'fpc_' + lowercase(tstringdef(dest.resulttype.def).stringtypname)+'_'; + if is_real then + procname := procname + 'float' + else + case torddef(dest.resulttype.def).typ of + u32bit: + procname := procname + 'cardinal'; + u64bit: + procname := procname + 'qword'; + s64bit: + procname := procname + 'int64'; + else + procname := procname + 'longint'; + end; + + { create the call node, } + newnode := ccallnode.createintern(procname,newparas); + { firstpass it } + firstpass(newnode); + + { and return it } + result := newnode; + end; +{$endif hascompilerproc} + + function tinlinenode.pass_1 : tnode; var srsym : tsym; @@ -1634,7 +1738,11 @@ implementation begin procinfo^.flags:=procinfo^.flags or pi_do_call; { calc registers } +{$ifndef hascompilerproc} left_max; +{$else not hascompilerproc} + result := str_pass_1; +{$endif not hascompilerproc} end; in_val_x : @@ -1793,7 +1901,10 @@ begin end. { $Log$ - Revision 1.46 2001-08-06 12:47:31 jonas + Revision 1.47 2001-08-13 12:41:57 jonas + * made code for str(x,y) completely processor independent + + Revision 1.46 2001/08/06 12:47:31 jonas * parameters to FPC_TYPED_WRITE can't be regvars (merged) Revision 1.45 2001/08/06 09:44:10 jonas