diff --git a/compiler/i386.pas b/compiler/i386.pas index 2003e7b3f3..762b38614d 100644 --- a/compiler/i386.pas +++ b/compiler/i386.pas @@ -207,10 +207,17 @@ unit i386; R_ST,R_ST0,R_ST1,R_ST2,R_ST3,R_ST4,R_ST5,R_ST6,R_ST7, R_MM0,R_MM1,R_MM2,R_MM3,R_MM4,R_MM5,R_MM6,R_MM7, R_XMM0,R_XMM1,R_XMM2,R_XMM3,R_XMM4,R_XMM5,R_XMM6,R_XMM7); + + tregisterset = set of tregister; + const firstreg = low(tregister); lastreg = high(tregister); + regset8bit : tregisterset = [R_AL..R_DH]; + regset16bit : tregisterset = [R_AX..R_DI,R_CS..R_SS]; + regset32bit : tregisterset = [R_EAX..R_EDI]; + type { S_NO = No Size of operand } { S_B = Byte size operand } @@ -463,6 +470,9 @@ unit i386; { can be ignored on 32 bit systems } function regtoreg64(reg : tregister) : tregister; + { returns the operand prefix for a given register } + function regsize(reg : tregister) : topsize; + { resets all values of ref to defaults } procedure reset_reference(var ref : treference); { set mostly used values of a new reference } @@ -1327,6 +1337,17 @@ unit i386; internalerror(6464); end; + function regsize(reg : tregister) : topsize; + + begin + if reg in regset8bit then + regsize:=S_B + else if reg in regset16bit then + regsize:=S_W + else if reg in regset32bit then + regsize:=S_L; + end; + procedure reset_reference(var ref : treference); begin @@ -1954,7 +1975,11 @@ Begin end. { $Log$ - Revision 1.30 1999-01-19 10:50:01 pierre + Revision 1.31 1999-01-23 23:29:31 florian + * first running version of the new code generator + * when compiling exceptions under Linux fixed + + Revision 1.30 1999/01/19 10:50:01 pierre * avoid result no set warning in regtoreg64 Revision 1.29 1999/01/19 10:19:02 florian diff --git a/compiler/new/cg386.pas b/compiler/new/cg386.pas index d5f58faef2..a4770b9076 100644 --- a/compiler/new/cg386.pas +++ b/compiler/new/cg386.pas @@ -25,7 +25,9 @@ unit cg386; interface uses - cgobj; + cgobj,aasm +{$i cpuunit.inc} + ; type pcg386 = ^tcg386; @@ -35,26 +37,35 @@ unit cg386; procedure a_call_name(list : paasmoutput;const s : string; offset : longint);virtual; - procedure a_load_const8_ref(list : paasmoutput;b : byte;ref : treference);virtual; - procedure a_load_const16_ref(list : paasmoutput;w : word;ref : treference);virtual; - procedure a_load_const32_ref(list : paasmoutput;l : longint;ref : treference);virtual; - procedure a_load_const64_ref(list : paasmoutput;{ q : qword; }ref : treference);virtual; + procedure a_load_const8_ref(list : paasmoutput;b : byte;const ref : treference);virtual; + procedure a_load_const16_ref(list : paasmoutput;w : word;const ref : treference);virtual; + procedure a_load_const32_ref(list : paasmoutput;l : longint;const ref : treference);virtual; + procedure a_load_const64_ref(list : paasmoutput;q : qword;const ref : treference);virtual; - procedure g_stackframe_entry(list : paasmoutput;localsize : longint); + procedure g_stackframe_entry(list : paasmoutput;localsize : longint);virtual; + constructor init; end; implementation + uses + globtype,globals; + + constructor tcg386.init; + + begin + inherited init; + end; + procedure tcg386.g_stackframe_entry(list : paasmoutput;localsize : longint); begin if localsize<>0 then begin - if (cs_littlesize in aktglobalswitches) and (stackframe<=65535) then - list^.insert(new(pai386,op_const_const(A_ENTER,S_NO,stackframe,0))) + if (cs_littlesize in aktglobalswitches) and (localsize<=65535) then + list^.insert(new(pai386,op_const_const(A_ENTER,S_NO,localsize,0))) else begin - g_stackframe_entry(list,stackframe); list^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EBP))); list^.concat(new(pai386,op_reg_reg(A_MOV,S_L,R_ESP,R_EBP))); list^.concat(new(pai386,op_const_reg(A_SUB,S_L,localsize,R_ESP))); @@ -74,10 +85,44 @@ unit cg386; list^.concat(new(pai386,op_csymbol(A_CALL,S_NO,newcsymbol(s,offset)))); end; + procedure tcg386.a_push_reg(list : paasmoutput;r : tregister); + + begin + list^.concat(new(pai386,op_reg(A_PUSH,regsize(r),r))); + end; + + procedure tcg386.a_load_const8_ref(list : paasmoutput;b : byte;const ref : treference); + + begin + abstract; + end; + + procedure tcg386.a_load_const16_ref(list : paasmoutput;w : word;const ref : treference); + + begin + abstract; + end; + + procedure tcg386.a_load_const32_ref(list : paasmoutput;l : longint;const ref : treference); + + begin + abstract; + end; + + procedure tcg386.a_load_const64_ref(list : paasmoutput;q : qword;const ref : treference); + + begin + abstract; + end; + end. { $Log$ - Revision 1.1 1998-12-15 22:17:02 florian + Revision 1.2 1999-01-23 23:29:43 florian + * first running version of the new code generator + * when compiling exceptions under Linux fixed + + Revision 1.1 1998/12/15 22:17:02 florian * first version } \ No newline at end of file diff --git a/compiler/new/cgbase.pas b/compiler/new/cgbase.pas index a314557506..94b8de2407 100644 --- a/compiler/new/cgbase.pas +++ b/compiler/new/cgbase.pas @@ -272,7 +272,6 @@ unit cgbase; end; - procedure codegen_donemodule; begin dispose(exprasmlist,done); @@ -395,7 +394,11 @@ unit cgbase; end. { $Log$ - Revision 1.3 1999-01-06 22:58:48 florian + Revision 1.4 1999-01-23 23:29:45 florian + * first running version of the new code generator + * when compiling exceptions under Linux fixed + + Revision 1.3 1999/01/06 22:58:48 florian + some stuff for the new code generator Revision 1.2 1998/12/26 15:20:28 florian diff --git a/compiler/new/cgobj.pas b/compiler/new/cgobj.pas index f49a98b892..176f8bcd1b 100644 --- a/compiler/new/cgobj.pas +++ b/compiler/new/cgobj.pas @@ -34,6 +34,9 @@ unit cgobj; pcg = ^tcg; tcg = object + constructor init; + destructor done;virtual; + procedure a_call_name_ext(list : paasmoutput;const s : string; offset : longint;m : texternal_typ); @@ -75,7 +78,7 @@ unit cgobj; procedure a_load_const64_ref(list : paasmoutput;q : qword;const ref : treference);virtual; - procedure g_stackframe_entry(list : paasmoutput;localsize : longint); + procedure g_stackframe_entry(list : paasmoutput;localsize : longint);virtual; procedure g_maybe_loadself(list : paasmoutput);virtual; {********************************************************} @@ -113,6 +116,16 @@ unit cgobj; {$endif i386} ; + constructor tcg.init; + + begin + end; + + destructor tcg.done; + + begin + end; + {***************************************************************************** per default, this methods nothing, can overriden *****************************************************************************} @@ -534,7 +547,7 @@ unit cgobj; var hs : string; hp : pused_unit; - unitinits,initcode : taasmoutput; + initcode : taasmoutput; {$ifdef GDB} stab_function_name : Pai_stab_function_name; {$endif GDB} @@ -552,61 +565,6 @@ unit cgobj; if not(cs_littlesize in aktglobalswitches) then list^.insert(new(pai_align,init(4))); end; - if (not inlined) and ((aktprocsym^.definition^.options and poproginit)<>0) then - begin - - { needs the target a console flags ? } - if tf_needs_isconsole in target_info.flags then - begin - hr.symbol:=stringdup('U_'+target_info.system_unit+'_ISCONSOLE'); - if apptype=at_cui then - a_load_const8_ref(list,1,hr) - else - a_load_const8_ref(list,0,hr); - stringdispose(hr.symbol); - end; - - { Call the unit init procedures } - unitinits.init; - - hp:=pused_unit(usedunits.first); - while assigned(hp) do - begin - { call the unit init code and make it external } - if (hp^.u^.flags and uf_init)<>0 then - a_call_name_ext(@unitinits, - 'INIT$$'+hp^.u^.modulename^,0,EXT_NEAR); - hp:=Pused_unit(hp^.next); - end; - list^.insertlist(@unitinits); - unitinits.done; - end; - - { a constructor needs a help procedure } - if (aktprocsym^.definition^.options and poconstructor)<>0 then - begin - if procinfo._class^.isclass then - begin - list^.insert(new(pai_labeled,init(A_JZ,quickexitlabel))); - list^.insert(new(pai386,op_csymbol(A_CALL,S_NO, - newcsymbol('FPC_NEW_CLASS',0)))); - concat_external('FPC_NEW_CLASS',EXT_NEAR); - end - else - begin - list^.insert(new(pai_labeled,init(A_JZ,quickexitlabel))); - list^.insert(new(pai386,op_csymbol(A_CALL,S_NO, - newcsymbol('FPC_HELP_CONSTRUCTOR',0)))); - list^.insert(new(pai386,op_const_reg(A_MOV,S_L,procinfo._class^.vmt_offset,R_EDI))); - concat_external('FPC_HELP_CONSTRUCTOR',EXT_NEAR); - end; - end; - - {$ifdef GDB} - if (cs_debuginfo in aktmoduleswitches) then - list^.insert(new(pai_force_line,init)); - {$endif GDB} - { save registers on cdecl } if ((aktprocsym^.definition^.options and pocdecl)<>0) then begin @@ -622,7 +580,6 @@ unit cgobj; a_push_reg(list,r); end; end; - { omit stack frame ? } if not inlined then if procinfo.framepointer=stack_pointer then @@ -654,6 +611,55 @@ unit cgobj; if cs_profile in aktmoduleswitches then g_profilecode(@initcode); + if (not inlined) and ((aktprocsym^.definition^.options and poproginit)<>0) then + begin + + { needs the target a console flags ? } + if tf_needs_isconsole in target_info.flags then + begin + hr.symbol:=stringdup('U_'+target_info.system_unit+'_ISCONSOLE'); + if apptype=at_cui then + a_load_const8_ref(list,1,hr) + else + a_load_const8_ref(list,0,hr); + stringdispose(hr.symbol); + end; + + hp:=pused_unit(usedunits.first); + while assigned(hp) do + begin + { call the unit init code and make it external } + if (hp^.u^.flags and uf_init)<>0 then + a_call_name_ext(list, + 'INIT$$'+hp^.u^.modulename^,0,EXT_NEAR); + hp:=Pused_unit(hp^.next); + end; + end; + + { a constructor needs a help procedure } + if (aktprocsym^.definition^.options and poconstructor)<>0 then + begin + if procinfo._class^.isclass then + begin + list^.insert(new(pai_labeled,init(A_JZ,quickexitlabel))); + list^.insert(new(pai386,op_csymbol(A_CALL,S_NO, + newcsymbol('FPC_NEW_CLASS',0)))); + concat_external('FPC_NEW_CLASS',EXT_NEAR); + end + else + begin + list^.insert(new(pai_labeled,init(A_JZ,quickexitlabel))); + list^.insert(new(pai386,op_csymbol(A_CALL,S_NO, + newcsymbol('FPC_HELP_CONSTRUCTOR',0)))); + list^.insert(new(pai386,op_const_reg(A_MOV,S_L,procinfo._class^.vmt_offset,R_EDI))); + concat_external('FPC_HELP_CONSTRUCTOR',EXT_NEAR); + end; + end; + + {$ifdef GDB} + if (cs_debuginfo in aktmoduleswitches) then + list^.insert(new(pai_force_line,init)); + {$endif GDB} { initialize return value } if is_ansistring(procinfo.retdef) or @@ -925,7 +931,11 @@ unit cgobj; end. { $Log$ - Revision 1.4 1999-01-13 22:52:36 florian + Revision 1.5 1999-01-23 23:29:46 florian + * first running version of the new code generator + * when compiling exceptions under Linux fixed + + Revision 1.4 1999/01/13 22:52:36 florian + YES, finally the new code generator is compilable, but it doesn't run yet :( Revision 1.3 1998/12/26 15:20:30 florian diff --git a/compiler/new/convtree.pas b/compiler/new/convtree.pas index cca378c1e2..a0497d9021 100644 --- a/compiler/new/convtree.pas +++ b/compiler/new/convtree.pas @@ -34,7 +34,7 @@ unit convtree; implementation uses - verbose; + verbose,nstatmnt; function convtree2node(p : ptree) : pnode; @@ -59,7 +59,11 @@ unit convtree; end. { $Log$ - Revision 1.2 1999-01-19 10:19:04 florian + Revision 1.3 1999-01-23 23:29:47 florian + * first running version of the new code generator + * when compiling exceptions under Linux fixed + + Revision 1.2 1999/01/19 10:19:04 florian * bug with mul. of dwords fixed, reported by Alexander Stohr * some changes to compile with TP + small enhancements for the new code generator diff --git a/compiler/new/pass_1.pas b/compiler/new/pass_1.pas index 2682bc1a56..d31912012e 100644 --- a/compiler/new/pass_1.pas +++ b/compiler/new/pass_1.pas @@ -108,84 +108,6 @@ implementation end; - procedure firstblock(var p : ptree); - var - hp : ptree; - count : longint; - begin - count:=0; - hp:=p^.left; - while assigned(hp) do - begin - if cs_regalloc in aktglobalswitches then - begin - { Codeumstellungen } - - { Funktionsresultate an exit anh„ngen } - { this is wrong for string or other complex - result types !!! } - if ret_in_acc(procinfo.retdef) and - assigned(hp^.left) and - (hp^.left^.right^.treetype=exitn) and - (hp^.right^.treetype=assignn) and - (hp^.right^.left^.treetype=funcretn) then - begin - if assigned(hp^.left^.right^.left) then - CGMessage(cg_n_inefficient_code) - else - begin - hp^.left^.right^.left:=getcopy(hp^.right^.right); - disposetree(hp^.right); - hp^.right:=nil; - end; - end - { warning if unreachable code occurs and elimate this } - else if (hp^.right^.treetype in - [exitn,breakn,continuen,goton]) and - assigned(hp^.left) and - (hp^.left^.treetype<>labeln) then - begin - { use correct line number } - aktfilepos:=hp^.left^.fileinfo; - disposetree(hp^.left); - hp^.left:=nil; - CGMessage(cg_w_unreachable_code); - { old lines } - aktfilepos:=hp^.right^.fileinfo; - end; - end; - if assigned(hp^.right) then - begin - cleartempgen; - firstpass(hp^.right); - if (not (cs_extsyntax in aktmoduleswitches)) and - assigned(hp^.right^.resulttype) and - (hp^.right^.resulttype<>pdef(voiddef)) then - CGMessage(cg_e_illegal_expression); - if codegenerror then - exit; - hp^.registers32:=hp^.right^.registers32; - hp^.registersfpu:=hp^.right^.registersfpu; -{$ifdef SUPPORT_MMX} - hp^.registersmmx:=hp^.right^.registersmmx; -{$endif SUPPORT_MMX} - end - else - hp^.registers32:=0; - - if hp^.registers32>p^.registers32 then - p^.registers32:=hp^.registers32; - if hp^.registersfpu>p^.registersfpu then - p^.registersfpu:=hp^.registersfpu; -{$ifdef SUPPORT_MMX} - if hp^.registersmmx>p^.registersmmx then - p^.registersmmx:=hp^.registersmmx; -{$endif} - inc(count); - hp:=hp^.left; - end; - end; - procedure firstasm(var p : ptree); begin @@ -298,7 +220,11 @@ implementation end. { $Log$ - Revision 1.2 1999-01-13 22:52:37 florian + Revision 1.3 1999-01-23 23:29:48 florian + * first running version of the new code generator + * when compiling exceptions under Linux fixed + + Revision 1.2 1999/01/13 22:52:37 florian + YES, finally the new code generator is compilable, but it doesn't run yet :( Revision 1.1 1998/12/26 15:20:31 florian diff --git a/compiler/new/tree.pas b/compiler/new/tree.pas index 9edf08eba5..a9f8edad2e 100644 --- a/compiler/new/tree.pas +++ b/compiler/new/tree.pas @@ -281,12 +281,13 @@ unit tree; tunarynode = object(tnode) left : pnode; procedure dowrite;virtual; - constructor init(l : pnode); + constructor init(l : pnode); end; pbinarynode = ^tbinarynode; tbinarynode = object(tunarynode) right : pnode; + constructor init(l,r : pnode); end; pbinopnode = ^tbinopnode; @@ -294,11 +295,7 @@ unit tree; { is true, if the right and left operand are swaped } { against the original order } swaped : boolean; - end; - - pblocknode = ^tblocknode; - tblocknode = object(tunarynode) - constructor init(l : pnode); + constructor init(l,r : pnode); end; {$ifdef dummy} @@ -460,7 +457,9 @@ unit tree; procedure tnode.pass_1; begin - det_resulttype; + if not(assigned(resulttype)) then + det_resulttype; + det_temp; end; @@ -623,20 +622,31 @@ unit tree; end; {**************************************************************************** - TBLOCKNODE + TBINARYNODE ****************************************************************************} - constructor tblocknode.init(l : pnode); + constructor tbinarynode.init(l,r : pnode); begin inherited init(l); - treetype:=blockn; + right:=r + end; + +{**************************************************************************** + TBINOPYNODE + ****************************************************************************} + + constructor tbinopnode.init(l,r : pnode); + + begin + inherited init(l,r); + swaped:=false; end; {$ifdef dummy} { clean up the contents of a node } case p^.treetype of - asmn : if assigned(p^.p_asm) then + asmn : if assigned(p^.p_asm) then dispose(p^.p_asm,done); stringconstn : begin ansistringdispose(p^.value_str,p^.length); @@ -1925,7 +1935,11 @@ unit tree; end. { $Log$ - Revision 1.4 1999-01-19 10:19:06 florian + Revision 1.5 1999-01-23 23:29:49 florian + * first running version of the new code generator + * when compiling exceptions under Linux fixed + + Revision 1.4 1999/01/19 10:19:06 florian * bug with mul. of dwords fixed, reported by Alexander Stohr * some changes to compile with TP + small enhancements for the new code generator diff --git a/compiler/parser.pas b/compiler/parser.pas index 7ca54772bd..594a3fcdc6 100644 --- a/compiler/parser.pas +++ b/compiler/parser.pas @@ -44,7 +44,7 @@ unit parser; const parser_current_file : string = ''; - + implementation uses @@ -61,6 +61,12 @@ unit parser; {$ifdef UseExcept} tpexcept,compiler, {$endif UseExcept} +{$ifdef newcg} + cgobj, + {$ifdef i386} + cg386, + {$endif i386} +{$endif newcg} tree,scanner,pbase,pdecl,psystem,pmodules; @@ -169,6 +175,9 @@ unit parser; recoverpos : jmp_buf; oldrecoverpos : pjmp_buf; {$endif useexcept} +{$ifdef newcg} + oldcg : pcg; +{$endif newcg} begin inc(compile_level); @@ -214,7 +223,9 @@ unit parser; oldaktasmmode:=aktasmmode; oldaktfilepos:=aktfilepos; oldaktmodeswitches:=aktmodeswitches; - +{$ifdef newcg} + oldcg:=cg; +{$endif newcg} { show info } Message1(parser_i_compiling,filename); @@ -267,7 +278,11 @@ unit parser; { init code generator for a new module } codegen_newmodule; - +{$ifdef newcg} +{$ifdef i386} + cg:=new(pcg386,init); +{$endif i386} +{$endif newcg} { Handle things which need to be once } if (compile_level=1) then begin @@ -314,6 +329,10 @@ unit parser; it's the default to release the trees } codegen_donemodule; +{$ifdef newcg} + dispose(cg,done); +{$endif newcg} + { free ppu } if assigned(current_module^.ppufile) then begin @@ -333,6 +352,9 @@ unit parser; if (compile_level>1) then begin +{$ifdef newcg} + cg:=oldcg; +{$endif newcg} { restore scanner } c:=oldc; pattern:=oldpattern; @@ -424,7 +446,11 @@ unit parser; end. { $Log$ - Revision 1.65 1999-01-22 12:19:31 pierre + Revision 1.66 1999-01-23 23:29:35 florian + * first running version of the new code generator + * when compiling exceptions under Linux fixed + + Revision 1.65 1999/01/22 12:19:31 pierre + currently compiled file name added on errors Revision 1.64 1999/01/12 14:25:29 peter diff --git a/compiler/pass_2.pas b/compiler/pass_2.pas index 16b9d503bc..a356a7369b 100644 --- a/compiler/pass_2.pas +++ b/compiler/pass_2.pas @@ -386,7 +386,7 @@ implementation begin { it is nonsens, to copy the variable to } { a register because we need then much } - { pushes ? } + { too pushes ? } if reg_pushes[varregs[i]]>=regvars[i]^.refs then begin regvars[i]:=nil; @@ -495,7 +495,11 @@ implementation end. { $Log$ - Revision 1.13 1998-12-30 13:41:09 peter + Revision 1.14 1999-01-23 23:29:37 florian + * first running version of the new code generator + * when compiling exceptions under Linux fixed + + Revision 1.13 1998/12/30 13:41:09 peter * released valuepara Revision 1.12 1998/12/19 00:23:51 florian diff --git a/compiler/pstatmnt.pas b/compiler/pstatmnt.pas index c351d67534..45f5fbd419 100644 --- a/compiler/pstatmnt.pas +++ b/compiler/pstatmnt.pas @@ -551,9 +551,6 @@ unit pstatmnt; { is a explicit name for the exception given ? } if token=COLON then begin - sym:=new(pvarsym,init(objname,nil)); - exceptsymtable:=new(psymtable,init(stt_exceptsymtable)); - exceptsymtable^.insert(sym); consume(COLON); getsym(pattern,false); consume(ID); @@ -571,7 +568,9 @@ unit pstatmnt; message(type_e_class_type_expected); ot:=pobjectdef(generrordef); end; - sym^.definition:=ot; + sym:=new(pvarsym,init(objname,ot)); + exceptsymtable:=new(psymtable,init(stt_exceptsymtable)); + exceptsymtable^.insert(sym); { insert the exception symtable stack } exceptsymtable^.next:=symtablestack; symtablestack:=exceptsymtable; @@ -1247,7 +1246,11 @@ unit pstatmnt; end. { $Log$ - Revision 1.59 1999-01-21 16:41:02 pierre + Revision 1.60 1999-01-23 23:29:38 florian + * first running version of the new code generator + * when compiling exceptions under Linux fixed + + Revision 1.59 1999/01/21 16:41:02 pierre * fix for constructor inside with statements Revision 1.58 1999/01/05 08:20:07 florian diff --git a/compiler/symsym.inc b/compiler/symsym.inc index 35ea82e3e8..40595380fc 100644 --- a/compiler/symsym.inc +++ b/compiler/symsym.inc @@ -846,10 +846,12 @@ var_options:=0; { can we load the value into a register ? } case p^.deftype of - pointerdef, + pointerdef, enumdef, - procvardef : var_options:=var_options or vo_regable; - orddef : case porddef(p)^.typ of + procvardef: + var_options:=var_options or vo_regable; + + orddef: case porddef(p)^.typ of u8bit,u16bit,u32bit, bool8bit,bool16bit,bool32bit, s8bit,s16bit,s32bit : @@ -857,6 +859,9 @@ else var_options:=var_options and not vo_regable; end; + setdef: + if psetdef(p)^.settype=smallset then + var_options:=var_options or vo_regable; else var_options:=var_options and not vo_regable; end; @@ -1764,7 +1769,11 @@ { $Log$ - Revision 1.70 1999-01-21 22:10:48 peter + Revision 1.71 1999-01-23 23:29:41 florian + * first running version of the new code generator + * when compiling exceptions under Linux fixed + + Revision 1.70 1999/01/21 22:10:48 peter * fixed array of const * generic platform independent high() support