Browse Source

* removed the tree dependency to types.pas
* long_fil.pas support (not fully tested yet)

peter 27 years ago
parent
commit
12c40adc06
3 changed files with 102 additions and 102 deletions
  1. 14 5
      compiler/files.pas
  2. 63 1
      compiler/tree.pas
  3. 25 96
      compiler/types.pas

+ 14 - 5
compiler/files.pas

@@ -134,7 +134,7 @@ unit files;
 {$else}
 {$else}
           function  load_ppu(const unit_path,n,ext:string):boolean;
           function  load_ppu(const unit_path,n,ext:string):boolean;
 {$endif}
 {$endif}
-          procedure search_unit(const n : string);
+          function  search_unit(const n : string):boolean;
        end;
        end;
 
 
        pused_unit = ^tused_unit;
        pused_unit = ^tused_unit;
@@ -522,7 +522,7 @@ unit files;
     end;
     end;
 
 
 
 
-    procedure tmodule.search_unit(const n : string);
+    function tmodule.search_unit(const n : string):boolean;
       var
       var
          ext       : string[8];
          ext       : string[8];
          singlepathstring,
          singlepathstring,
@@ -597,6 +597,7 @@ unit files;
                sources_avail:=false;
                sources_avail:=false;
             end;
             end;
          until Found or (path='');
          until Found or (path='');
+         search_unit:=Found;
       end;
       end;
 
 
 {$else NEWPPU}
 {$else NEWPPU}
@@ -768,7 +769,7 @@ unit files;
       load_ppu:=true;
       load_ppu:=true;
     end;
     end;
 
 
-    procedure tmodule.search_unit(const n : string);
+    function tmodule.search_unit(const n : string):boolean;
       var
       var
          ext       : string[8];
          ext       : string[8];
          singlepathstring,
          singlepathstring,
@@ -843,6 +844,7 @@ unit files;
                sources_avail:=false;
                sources_avail:=false;
             end;
             end;
          until Found or (path='');
          until Found or (path='');
+         search_unit:=Found;
       end;
       end;
 
 
 {$endif NEWPPU}
 {$endif NEWPPU}
@@ -895,7 +897,10 @@ unit files;
           flags:=flags or uf_smartlink;
           flags:=flags or uf_smartlink;
        { search the PPU file if it is an unit }
        { search the PPU file if it is an unit }
          if is_unit then
          if is_unit then
-          search_unit(modulename^);
+          begin
+            if (not search_unit(modulename^)) and (length(modulename^)>8) then
+             search_unit(copy(modulename^,1,8));
+          end;
       end;
       end;
 
 
     destructor tmodule.special_done;
     destructor tmodule.special_done;
@@ -940,7 +945,11 @@ unit files;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.19  1998-06-12 10:32:26  pierre
+  Revision 1.20  1998-06-12 14:50:48  peter
+    * removed the tree dependency to types.pas
+    * long_fil.pas support (not fully tested yet)
+
+  Revision 1.19  1998/06/12 10:32:26  pierre
     * column problem hopefully solved
     * column problem hopefully solved
     + C vars declaration changed
     + C vars declaration changed
 
 

+ 63 - 1
compiler/tree.pas

@@ -289,6 +289,17 @@ unit tree;
        maxfirstpasscount : longint = 0;
        maxfirstpasscount : longint = 0;
 {$endif extdebug}
 {$endif extdebug}
 
 
+    { gibt den ordinalen Werten der Node zurueck oder falls sie }
+    { keinen ordinalen Wert hat, wird ein Fehler erzeugt        }
+    function get_ordinal_value(p : ptree) : longint;
+
+    { true, if p is a pointer to a const int value }
+    function is_constintnode(p : ptree) : boolean;
+    { like is_constintnode }
+    function is_constboolnode(p : ptree) : boolean;
+    function is_constrealnode(p : ptree) : boolean;
+    function is_constcharnode(p : ptree) : boolean;
+
 {$I innr.inc}
 {$I innr.inc}
 
 
   implementation
   implementation
@@ -1537,10 +1548,61 @@ unit tree;
          destloc := sourceloc;
          destloc := sourceloc;
          sourceloc := swapl;
          sourceloc := swapl;
       end;
       end;
+
+
+    function get_ordinal_value(p : ptree) : longint;
+      begin
+         if p^.treetype=ordconstn then
+           get_ordinal_value:=p^.value
+         else
+           Message(parser_e_ordinal_expected);
+      end;
+
+
+    function is_constintnode(p : ptree) : boolean;
+
+      begin
+         {DM: According to me, an orddef with anysize, is
+          a correct constintnode. Anyway I commented changed s32bit check,
+          because it caused problems with statements like a:=high(word).}
+         is_constintnode:=((p^.treetype=ordconstn) and
+           (p^.resulttype^.deftype=orddef) and
+           (porddef(p^.resulttype)^.typ in [u8bit,s8bit,u16bit,s16bit,
+            u32bit,s32bit,uauto]));
+      end;
+
+    function is_constcharnode(p : ptree) : boolean;
+
+      begin
+         is_constcharnode:=((p^.treetype=ordconstn) and
+           (p^.resulttype^.deftype=orddef) and
+           (porddef(p^.resulttype)^.typ=uchar));
+      end;
+
+    function is_constrealnode(p : ptree) : boolean;
+
+      begin
+         is_constrealnode:=(p^.treetype=realconstn);
+      end;
+
+    function is_constboolnode(p : ptree) : boolean;
+
+      begin
+         is_constboolnode:=((p^.treetype=ordconstn) and
+           (p^.resulttype^.deftype=orddef) and
+           (porddef(p^.resulttype)^.typ in [bool8bit,bool16bit,bool32bit]));
+      end;
+
+
+
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.15  1998-06-06 08:39:07  peter
+  Revision 1.16  1998-06-12 14:50:49  peter
+    * removed the tree dependency to types.pas
+    * long_fil.pas support (not fully tested yet)
+
+  Revision 1.15  1998/06/06 08:39:07  peter
     * it needs types
     * it needs types
 
 
   Revision 1.14  1998/06/05 14:37:40  pierre
   Revision 1.14  1998/06/05 14:37:40  pierre

+ 25 - 96
compiler/types.pas

@@ -25,7 +25,7 @@ unit types;
   interface
   interface
 
 
     uses
     uses
-       cobjects,globals,symtable,tree;
+       cobjects,globals,symtable;
 
 
     type
     type
        tmmxtype = (mmxno,mmxu8bit,mmxs8bit,mmxu16bit,mmxs16bit,
        tmmxtype = (mmxno,mmxu8bit,mmxs8bit,mmxu16bit,mmxs16bit,
@@ -81,10 +81,6 @@ unit types;
     { equal                                         }
     { equal                                         }
     function equal_paras(def1,def2 : pdefcoll;value_equal_const : boolean) : boolean;
     function equal_paras(def1,def2 : pdefcoll;value_equal_const : boolean) : boolean;
 
 
-    { gibt den ordinalen Werten der Node zurueck oder falls sie }
-    { keinen ordinalen Wert hat, wird ein Fehler erzeugt        }
-    function get_ordinal_value(p : ptree) : longint;
-
     { if l isn't in the range of def a range check error is generated }
     { if l isn't in the range of def a range check error is generated }
     procedure testrange(def : pdef;l : longint);
     procedure testrange(def : pdef;l : longint);
 
 
@@ -94,14 +90,6 @@ unit types;
     { generates a VMT for _class }
     { generates a VMT for _class }
     procedure genvmt(_class : pobjectdef);
     procedure genvmt(_class : pobjectdef);
 
 
-    { true, if p is a pointer to a const int value }
-    function is_constintnode(p : ptree) : boolean;
-
-    { like is_constintnode }
-    function is_constboolnode(p : ptree) : boolean;
-    function is_constrealnode(p : ptree) : boolean;
-    function is_constcharnode(p : ptree) : boolean;
-
     { some type helper routines for MMX support }
     { some type helper routines for MMX support }
     function is_mmx_able_array(p : pdef) : boolean;
     function is_mmx_able_array(p : pdef) : boolean;
 
 
@@ -112,40 +100,6 @@ unit types;
 
 
     uses verbose,aasm;
     uses verbose,aasm;
 
 
-    function is_constintnode(p : ptree) : boolean;
-
-      begin
-         {DM: According to me, an orddef with anysize, is
-          a correct constintnode. Anyway I commented changed s32bit check,
-          because it caused problems with statements like a:=high(word).}
-         is_constintnode:=((p^.treetype=ordconstn) and
-           (p^.resulttype^.deftype=orddef) and
-           (porddef(p^.resulttype)^.typ in [u8bit,s8bit,u16bit,s16bit,
-            u32bit,s32bit,uauto]));
-      end;
-
-    function is_constcharnode(p : ptree) : boolean;
-
-      begin
-         is_constcharnode:=((p^.treetype=ordconstn) and
-           (p^.resulttype^.deftype=orddef) and
-           (porddef(p^.resulttype)^.typ=uchar));
-      end;
-
-    function is_constrealnode(p : ptree) : boolean;
-
-      begin
-         is_constrealnode:=(p^.treetype=realconstn);
-      end;
-
-    function is_constboolnode(p : ptree) : boolean;
-
-      begin
-         is_constboolnode:=((p^.treetype=ordconstn) and
-           (p^.resulttype^.deftype=orddef) and
-           (porddef(p^.resulttype)^.typ in [bool8bit,bool16bit,bool32bit]));
-      end;
-
     function equal_paras(def1,def2 : pdefcoll;value_equal_const : boolean) : boolean;
     function equal_paras(def1,def2 : pdefcoll;value_equal_const : boolean) : boolean;
 
 
       begin
       begin
@@ -223,86 +177,66 @@ unit types;
 
 
       begin
       begin
          is_open_array:=(p^.deftype=arraydef) and
          is_open_array:=(p^.deftype=arraydef) and
-                 (parraydef(p)^.lowrange=0) and
-                 (parraydef(p)^.highrange=-1);
+                        (parraydef(p)^.lowrange=0) and
+                        (parraydef(p)^.highrange=-1);
       end;
       end;
 
 
     { true if o is an ansi string def }
     { true if o is an ansi string def }
     function is_ansistring(p : pdef) : boolean;
     function is_ansistring(p : pdef) : boolean;
       begin
       begin
          is_ansistring:=(p^.deftype=stringdef) and
          is_ansistring:=(p^.deftype=stringdef) and
-                 (pstringdef(p)^.string_typ=ansistring);
+                        (pstringdef(p)^.string_typ=ansistring);
       end;
       end;
 
 
     { true if o is an long string def }
     { true if o is an long string def }
     function is_longstring(p : pdef) : boolean;
     function is_longstring(p : pdef) : boolean;
       begin
       begin
          is_longstring:=(p^.deftype=stringdef) and
          is_longstring:=(p^.deftype=stringdef) and
-                 (pstringdef(p)^.string_typ=longstring);
+                        (pstringdef(p)^.string_typ=longstring);
       end;
       end;
 
 
-    { true if o is an long string def }
+    { true if o is an wide string def }
     function is_widestring(p : pdef) : boolean;
     function is_widestring(p : pdef) : boolean;
       begin
       begin
          is_widestring:=(p^.deftype=stringdef) and
          is_widestring:=(p^.deftype=stringdef) and
-                 (pstringdef(p)^.string_typ=widestring);
+                        (pstringdef(p)^.string_typ=widestring);
       end;
       end;
 
 
     { true if o is an short string def }
     { true if o is an short string def }
     function is_shortstring(p : pdef) : boolean;
     function is_shortstring(p : pdef) : boolean;
       begin
       begin
          is_shortstring:=(p^.deftype=stringdef) and
          is_shortstring:=(p^.deftype=stringdef) and
-                 (pstringdef(p)^.string_typ=shortstring);
+                         (pstringdef(p)^.string_typ=shortstring);
       end;
       end;
 
 
     { true if the return value is in accumulator (EAX for i386), D0 for 68k }
     { true if the return value is in accumulator (EAX for i386), D0 for 68k }
     function ret_in_acc(def : pdef) : boolean;
     function ret_in_acc(def : pdef) : boolean;
 
 
       begin
       begin
-         ret_in_acc:=(def^.deftype=orddef) or
-                     (def^.deftype=pointerdef) or
-                     (def^.deftype=enumdef) or
-                     ((def^.deftype=procvardef) and
-                      ((pprocvardef(def)^.options and pomethodpointer)=0)) or
-                     (def^.deftype=classrefdef) or
-                     ((def^.deftype=objectdef) and
-                      pobjectdef(def)^.isclass
-                     ) or
-                     ((def^.deftype=setdef) and
-                      (psetdef(def)^.settype=smallset)) or
-                     ((def^.deftype=floatdef) and
-                      (pfloatdef(def)^.typ=f32bit));
+         ret_in_acc:=(def^.deftype in [orddef,pointerdef,enumdef,classrefdef]) or
+                     ((def^.deftype=procvardef) and ((pprocvardef(def)^.options and pomethodpointer)=0)) or
+                     ((def^.deftype=objectdef) and pobjectdef(def)^.isclass) or
+                     ((def^.deftype=setdef) and (psetdef(def)^.settype=smallset)) or
+                     ((def^.deftype=floatdef) and (pfloatdef(def)^.typ=f32bit));
       end;
       end;
 
 
     { true if uses a parameter as return value }
     { true if uses a parameter as return value }
     function ret_in_param(def : pdef) : boolean;
     function ret_in_param(def : pdef) : boolean;
 
 
       begin
       begin
-         ret_in_param:=(def^.deftype=arraydef) or
-                       (def^.deftype=stringdef) or
-                       ((def^.deftype=procvardef) and
-                        ((pprocvardef(def)^.options and pomethodpointer)<>0)) or
-                       ((def^.deftype=objectdef) and
-                        ((pobjectdef(def)^.options and oois_class)=0)
-                       ) or
-                       (def^.deftype=recorddef) or
-                       ((def^.deftype=setdef) and
-                        (psetdef(def)^.settype<>smallset));
+         ret_in_param:=(def^.deftype in [arraydef,recorddef,stringdef]) or
+                       ((def^.deftype=procvardef) and ((pprocvardef(def)^.options and pomethodpointer)<>0)) or
+                       ((def^.deftype=objectdef) and ((pobjectdef(def)^.options and oois_class)=0)) or
+                       ((def^.deftype=setdef) and (psetdef(def)^.settype<>smallset));
       end;
       end;
 
 
     { true if a const parameter is too large to copy }
     { true if a const parameter is too large to copy }
     function dont_copy_const_param(def : pdef) : boolean;
     function dont_copy_const_param(def : pdef) : boolean;
 
 
       begin
       begin
-         dont_copy_const_param:=(def^.deftype=arraydef) or
-                       (def^.deftype=stringdef) or
-                       (def^.deftype=objectdef) or
-                       (def^.deftype=formaldef) or
-                       (def^.deftype=recorddef) or
-                       ((def^.deftype=procvardef) and
-                        ((pprocvardef(def)^.options and pomethodpointer)<>0)) or
-                       ((def^.deftype=setdef) and
-                        (psetdef(def)^.settype<>smallset));
+         dont_copy_const_param:=(def^.deftype in [arraydef,stringdef,objectdef,formaldef,recorddef]) or
+                       ((def^.deftype=procvardef) and ((pprocvardef(def)^.options and pomethodpointer)<>0)) or
+                       ((def^.deftype=setdef) and (psetdef(def)^.settype<>smallset));
       end;
       end;
 
 
     procedure testrange(def : pdef;l : longint);
     procedure testrange(def : pdef;l : longint);
@@ -350,15 +284,6 @@ unit types;
       end;
       end;
 
 
 
 
-    function get_ordinal_value(p : ptree) : longint;
-      begin
-         if p^.treetype=ordconstn then
-           get_ordinal_value:=p^.value
-         else
-           Message(parser_e_ordinal_expected);
-      end;
-
-
     function mmx_type(p : pdef) : tmmxtype;
     function mmx_type(p : pdef) : tmmxtype;
       begin
       begin
          mmx_type:=mmxno;
          mmx_type:=mmxno;
@@ -928,7 +853,11 @@ unit types;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.13  1998-06-03 22:49:07  peter
+  Revision 1.14  1998-06-12 14:50:50  peter
+    * removed the tree dependency to types.pas
+    * long_fil.pas support (not fully tested yet)
+
+  Revision 1.13  1998/06/03 22:49:07  peter
     + wordbool,longbool
     + wordbool,longbool
     * rename bis,von -> high,low
     * rename bis,von -> high,low
     * moved some systemunit loading/creating to psystem.pas
     * moved some systemunit loading/creating to psystem.pas