Răsfoiți Sursa

+ first versions

florian 26 ani în urmă
părinte
comite
ce1b4eff9e
2 a modificat fișierele cu 233 adăugiri și 0 ștergeri
  1. 144 0
      compiler/new/nstatmnt.pas
  2. 89 0
      compiler/new/transn.pas

+ 144 - 0
compiler/new/nstatmnt.pas

@@ -0,0 +1,144 @@
+{
+    $Id$
+    Copyright (C) 1993-99 by Florian Klaempfl
+
+    This unit implements block, statement nodes etc.
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit nstatmnt;
+
+  interface
+
+    uses
+       tree;
+
+    type
+       pblocknode = ^tblocknode;
+       tblocknode = object(tunarynode)
+         constructor init(l : pnode);
+         procedure det_temp;virtual;
+         procedure det_resulttype;virtual;
+       end;
+
+       pstatementnode = ^tstatementnode;
+       tstatementnode = object(tbinarynode)
+          constructor init(l,r : pnode);
+       end;
+
+  implementation
+
+    uses
+       temp_gen,tgeni386,globtype,globals,symtable,verbose,cgbase;
+
+{****************************************************************************
+                                 TSTAMENTNODE
+ ****************************************************************************}
+
+    constructor tstatementnode.init(l,r : pnode);
+
+      begin
+         inherited init(l,r);
+         treetype:=statementn;
+      end;
+
+{****************************************************************************
+                                 TBLOCKNODE
+ ****************************************************************************}
+
+    constructor tblocknode.init(l : pnode);
+
+      begin
+         inherited init(l);
+         treetype:=blockn;
+      end;
+
+    procedure tblocknode.det_resulttype;
+
+      var
+         hp : pstatementnode;
+
+      begin
+         hp:=pstatementnode(left);
+         while assigned(hp) do
+           begin
+              if assigned(pstatementnode(hp)^.right) then
+                begin
+                   cleartempgen;
+                   hp^.right^.det_resulttype;
+                   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;
+                end;
+              hp:=pstatementnode(hp^.left);
+           end;
+      end;
+
+    procedure tblocknode.det_temp;
+
+      var
+         hp : pstatementnode;
+
+      begin
+         hp:=pstatementnode(left);
+         while assigned(hp) do
+           begin
+              if assigned(hp^.right) then
+                begin
+                   cleartempgen;
+                   hp^.right^.det_temp;
+                   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^.registersint:=hp^.right^.registersint;
+                   hp^.registersfpu:=hp^.right^.registersfpu;
+{$ifdef SUPPORT_MMX}
+                   hp^.registersmmx:=hp^.right^.registersmmx;
+                   hp^.registerskni:=hp^.right^.registerskni;
+{$endif SUPPORT_MMX}
+                end
+              else
+                hp^.registersint:=0;
+
+              if hp^.registersint>registersint then
+                registersint:=hp^.registersint;
+              if hp^.registersfpu>registersfpu then
+                registersfpu:=hp^.registersfpu;
+{$ifdef SUPPORT_MMX}
+              if hp^.registersmmx>registersmmx then
+                registersmmx:=hp^.registersmmx;
+              if hp^.registerskni>registerskni then
+                registerskni:=hp^.registerskni;
+{$endif}
+              hp:=pstatementnode(hp^.left);
+           end;
+      end;
+
+
+end.
+{
+  $Log$
+  Revision 1.1  1999-01-23 23:35:02  florian
+    + first versions
+
+}

+ 89 - 0
compiler/new/transn.pas

@@ -0,0 +1,89 @@
+{
+    $Id$
+    Copyright (c) 1993-98 by Florian Klaempfl
+
+    This unit does node transformations
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+
+unit transn;
+
+  interface
+
+  implementation
+
+{ The following stuff needs to be implemented: }
+
+{$ifdef dummy}
+blockn:
+
+
+         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;
+              hp:=hp^.left;
+           end;
+{$endif dummy}
+
+end.
+
+{
+  $Log$
+  Revision 1.1  1999-01-23 23:35:02  florian
+    + first versions
+
+}
+