development/compilers/freepascal/compiler/psystem.pas

   1 {
   2     $Id$
   3     Copyright (c) 1998-2000 by Florian Klaempfl
   4
   5     Load the system unit, create required defs for systemunit
   6
   7     This program is free software; you can redistribute it and/or modify
   8     it under the terms of the GNU General Public License as published by
   9     the Free Software Foundation; either version 2 of the License, or
  10     (at your option) any later version.
  11
  12     This program is distributed in the hope that it will be useful,
  13     but WITHOUT ANY WARRANTY; without even the implied warranty of
  14     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15     GNU General Public License for more details.
  16
  17     You should have received a copy of the GNU General Public License
  18     along with this program; if not, write to the Free Software
  19     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20
  21  ****************************************************************************
  22 }
  23 unit psystem;
  24 interface
  25 uses symtable;
  26
  27 procedure insertinternsyms(p : psymtable);
  28 procedure insert_intern_types(p : psymtable);
  29
  30 procedure readconstdefs;
  31 procedure createconstdefs;
  32
  33 implementation
  34
  35 uses
  36   globtype,globals,symconst,tree;
  37
  38 procedure insertinternsyms(p : psymtable);
  39 {
  40   all intern procedures for system unit
  41 }
  42 begin
  43   p^.insert(new(psyssym,init('CONCAT',in_concat_x)));
  44   p^.insert(new(psyssym,init('WRITE',in_write_x)));
  45   p^.insert(new(psyssym,init('WRITELN',in_writeln_x)));
  46   p^.insert(new(psyssym,init('ASSIGNED',in_assigned_x)));
  47   p^.insert(new(psyssym,init('READ',in_read_x)));
  48   p^.insert(new(psyssym,init('READLN',in_readln_x)));
  49   p^.insert(new(psyssym,init('OFS',in_ofs_x)));
  50   p^.insert(new(psyssym,init('SIZEOF',in_sizeof_x)));
  51   p^.insert(new(psyssym,init('TYPEOF',in_typeof_x)));
  52   p^.insert(new(psyssym,init('LOW',in_low_x)));
  53   p^.insert(new(psyssym,init('HIGH',in_high_x)));
  54   p^.insert(new(psyssym,init('SEG',in_seg_x)));
  55   p^.insert(new(psyssym,init('ORD',in_ord_x)));
  56   p^.insert(new(psyssym,init('PRED',in_pred_x)));
  57   p^.insert(new(psyssym,init('SUCC',in_succ_x)));
  58   p^.insert(new(psyssym,init('EXCLUDE',in_exclude_x_y)));
  59   p^.insert(new(psyssym,init('INCLUDE',in_include_x_y)));
  60   p^.insert(new(psyssym,init('BREAK',in_break)));
  61   p^.insert(new(psyssym,init('CONTINUE',in_continue)));
  62   p^.insert(new(psyssym,init('DEC',in_dec_x)));
  63   p^.insert(new(psyssym,init('INC',in_inc_x)));
  64   p^.insert(new(psyssym,init('STR',in_str_x_string)));
  65   p^.insert(new(psyssym,init('ASSERT',in_assert_x_y)));
  66   p^.insert(new(psyssym,init('VAL',in_val_x)));
  67   p^.insert(new(psyssym,init('ADDR',in_addr_x)));
  68 end;
  69
  70
  71 procedure insert_intern_types(p : psymtable);
  72 {
  73   all the types inserted into the system unit
  74 }
  75 var
  76   { several defs to simulate more or less C++ objects for GDB }
  77   vmtdef      : precorddef;
  78   vmtarraydef : parraydef;
  79   vmtsymtable : psymtable;
  80 begin
  81 { Internal types }
  82   p^.insert(new(ptypesym,initdef('formal',cformaldef)));
  83   p^.insert(new(ptypesym,initdef('void',voiddef)));
  84   p^.insert(new(ptypesym,initdef('byte',u8bitdef)));
  85   p^.insert(new(ptypesym,initdef('word',u16bitdef)));
  86   p^.insert(new(ptypesym,initdef('ulong',u32bitdef)));
  87   p^.insert(new(ptypesym,initdef('longint',s32bitdef)));
  88   p^.insert(new(ptypesym,initdef('qword',cu64bitdef)));
  89   p^.insert(new(ptypesym,initdef('int64',cs64bitdef)));
  90   p^.insert(new(ptypesym,initdef('char',cchardef)));
  91   p^.insert(new(ptypesym,initdef('widechar',cwidechardef)));
  92   p^.insert(new(ptypesym,initdef('shortstring',cshortstringdef)));
  93   p^.insert(new(ptypesym,initdef('longstring',clongstringdef)));
  94   p^.insert(new(ptypesym,initdef('ansistring',cansistringdef)));
  95   p^.insert(new(ptypesym,initdef('widestring',cwidestringdef)));
  96   p^.insert(new(ptypesym,initdef('openshortstring',openshortstringdef)));
  97   p^.insert(new(ptypesym,initdef('boolean',booldef)));
  98   p^.insert(new(ptypesym,initdef('void_pointer',voidpointerdef)));
  99   p^.insert(new(ptypesym,initdef('char_pointer',charpointerdef)));
 100   p^.insert(new(ptypesym,initdef('void_farpointer',voidfarpointerdef)));
 101   p^.insert(new(ptypesym,initdef('openchararray',openchararraydef)));
 102   p^.insert(new(ptypesym,initdef('file',cfiledef)));
 103   p^.insert(new(ptypesym,initdef('s32real',s32floatdef)));
 104   p^.insert(new(ptypesym,initdef('s64real',s64floatdef)));
 105   p^.insert(new(ptypesym,initdef('s80real',s80floatdef)));
 106 {$ifdef SUPPORT_FIXED}
 107   p^.insert(new(ptypesym,initdef('s32fixed',s32fixeddef)));
 108 {$endif SUPPORT_FIXED}
 109   { Add a type for virtual method tables in lowercase }
 110   { so it isn't reachable!                            }
 111   vmtsymtable:=new(psymtable,init(recordsymtable));
 112   vmtdef:=new(precorddef,init(vmtsymtable));
 113   pvmtdef:=new(ppointerdef,initdef(vmtdef));
 114   vmtsymtable^.insert(new(pvarsym,initdef('parent',pvmtdef)));
 115   vmtsymtable^.insert(new(pvarsym,initdef('length',globaldef('longint'))));
 116   vmtsymtable^.insert(new(pvarsym,initdef('mlength',globaldef('longint'))));
 117   vmtarraydef:=new(parraydef,init(0,1,s32bitdef));
 118   vmtarraydef^.elementtype.setdef(voidpointerdef);
 119   vmtsymtable^.insert(new(pvarsym,initdef('__pfn',vmtarraydef)));
 120   p^.insert(new(ptypesym,initdef('__vtbl_ptr_type',vmtdef)));
 121   p^.insert(new(ptypesym,initdef('pvmt',pvmtdef)));
 122   vmtarraydef:=new(parraydef,init(0,1,s32bitdef));
 123   vmtarraydef^.elementtype.setdef(pvmtdef);
 124   p^.insert(new(ptypesym,initdef('vtblarray',vmtarraydef)));
 125   insertinternsyms(p);
 126 { Normal types }
 127   p^.insert(new(ptypesym,initdef('SINGLE',s32floatdef)));
 128   p^.insert(new(ptypesym,initdef('DOUBLE',s64floatdef)));
 129   p^.insert(new(ptypesym,initdef('EXTENDED',s80floatdef)));
 130   p^.insert(new(ptypesym,initdef('REAL',s64floatdef)));
 131 {$ifdef i386}
 132   p^.insert(new(ptypesym,initdef('COMP',new(pfloatdef,init(s64comp)))));
 133 {$endif}
 134   p^.insert(new(ptypesym,initdef('POINTER',voidpointerdef)));
 135   p^.insert(new(ptypesym,initdef('FARPOINTER',voidfarpointerdef)));
 136   p^.insert(new(ptypesym,initdef('SHORTSTRING',cshortstringdef)));
 137   p^.insert(new(ptypesym,initdef('LONGSTRING',clongstringdef)));
 138   p^.insert(new(ptypesym,initdef('ANSISTRING',cansistringdef)));
 139   p^.insert(new(ptypesym,initdef('WIDESTRING',cwidestringdef)));
 140   p^.insert(new(ptypesym,initdef('BOOLEAN',booldef)));
 141   p^.insert(new(ptypesym,initdef('BYTEBOOL',booldef)));
 142   p^.insert(new(ptypesym,initdef('WORDBOOL',new(porddef,init(bool16bit,0,1)))));
 143   p^.insert(new(ptypesym,initdef('LONGBOOL',new(porddef,init(bool32bit,0,1)))));
 144   p^.insert(new(ptypesym,initdef('CHAR',cchardef)));
 145   p^.insert(new(ptypesym,initdef('WIDECHAR',cwidechardef)));
 146   p^.insert(new(ptypesym,initdef('TEXT',new(pfiledef,inittext))));
 147   p^.insert(new(ptypesym,initdef('CARDINAL',u32bitdef)));
 148 {$ifdef SUPPORT_FIXED}
 149   p^.insert(new(ptypesym,initdef('FIXED',new(pfloatdef,init(f32bit)))));
 150   p^.insert(new(ptypesym,initdef('FIXED16',new(pfloatdef,init(f16bit)))));
 151 {$endif SUPPORT_FIXED}
 152   p^.insert(new(ptypesym,initdef('QWORD',cu64bitdef)));
 153   p^.insert(new(ptypesym,initdef('INT64',cs64bitdef)));
 154   p^.insert(new(ptypesym,initdef('TYPEDFILE',new(pfiledef,inittypeddef(voiddef)))));
 155 end;
 156
 157
 158 procedure readconstdefs;
 159 {
 160   Load all default definitions for consts from the system unit
 161 }
 162 begin
 163   u8bitdef:=porddef(globaldef('byte'));
 164   u16bitdef:=porddef(globaldef('word'));
 165   u32bitdef:=porddef(globaldef('ulong'));
 166   s32bitdef:=porddef(globaldef('longint'));
 167   cu64bitdef:=porddef(globaldef('qword'));
 168   cs64bitdef:=porddef(globaldef('int64'));
 169   cformaldef:=pformaldef(globaldef('formal'));
 170   voiddef:=porddef(globaldef('void'));
 171   cchardef:=porddef(globaldef('char'));
 172   cwidechardef:=porddef(globaldef('char'));
 173   cshortstringdef:=pstringdef(globaldef('shortstring'));
 174   clongstringdef:=pstringdef(globaldef('longstring'));
 175   cansistringdef:=pstringdef(globaldef('ansistring'));
 176   cwidestringdef:=pstringdef(globaldef('widestring'));
 177   openshortstringdef:=pstringdef(globaldef('openshortstring'));
 178   openchararraydef:=parraydef(globaldef('openchararray'));
 179   s32floatdef:=pfloatdef(globaldef('s32real'));
 180   s64floatdef:=pfloatdef(globaldef('s64real'));
 181   s80floatdef:=pfloatdef(globaldef('s80real'));
 182 {$ifdef SUPPORT_FIXED}
 183   s32fixeddef:=pfloatdef(globaldef('s32fixed'));
 184 {$endif SUPPORT_FIXED}
 185   booldef:=porddef(globaldef('boolean'));
 186   voidpointerdef:=ppointerdef(globaldef('void_pointer'));
 187   charpointerdef:=ppointerdef(globaldef('char_pointer'));
 188   voidfarpointerdef:=ppointerdef(globaldef('void_farpointer'));
 189   cfiledef:=pfiledef(globaldef('file'));
 190   pvmtdef:=ppointerdef(globaldef('pvmt'));
 191 end;
 192
 193
 194 procedure createconstdefs;
 195 {
 196   Create all default definitions for consts for the system unit
 197 }
 198 var
 199   oldregisterdef : boolean;
 200 begin
 201   { create definitions for constants }
 202   oldregisterdef:=registerdef;
 203   registerdef:=false;
 204   cformaldef:=new(pformaldef,init);
 205   voiddef:=new(porddef,init(uvoid,0,0));
 206   u8bitdef:=new(porddef,init(u8bit,0,255));
 207   u16bitdef:=new(porddef,init(u16bit,0,65535));
 208   u32bitdef:=new(porddef,init(u32bit,0,$ffffffff));
 209   s32bitdef:=new(porddef,init(s32bit,$80000000,$7fffffff));
 210   cu64bitdef:=new(porddef,init(u64bit,0,0));
 211   cs64bitdef:=new(porddef,init(s64bit,0,0));
 212   booldef:=new(porddef,init(bool8bit,0,1));
 213   cchardef:=new(porddef,init(uchar,0,255));
 214   cwidechardef:=new(porddef,init(uwidechar,0,65535));
 215   cshortstringdef:=new(pstringdef,shortinit(255));
 216   { should we give a length to the default long and ansi string definition ?? }
 217   clongstringdef:=new(pstringdef,longinit(-1));
 218   cansistringdef:=new(pstringdef,ansiinit(-1));
 219   cwidestringdef:=new(pstringdef,wideinit(-1));
 220   { length=0 for shortstring is open string (needed for readln(string) }
 221   openshortstringdef:=new(pstringdef,shortinit(0));
 222   openchararraydef:=new(parraydef,init(0,-1,s32bitdef));
 223   parraydef(openchararraydef)^.elementtype.setdef(cchardef);
 224 {$ifdef i386}
 225   s32floatdef:=new(pfloatdef,init(s32real));
 226   s64floatdef:=new(pfloatdef,init(s64real));
 227   s80floatdef:=new(pfloatdef,init(s80real));
 228 {$endif}
 229 {$ifdef m68k}
 230   s32floatdef:=new(pfloatdef,init(s32real));
 231   s64floatdef:=new(pfloatdef,init(s64real));
 232   if (cs_fp_emulation in aktmoduleswitches) then
 233    s80floatdef:=new(pfloatdef,init(s32real))
 234   else
 235    s80floatdef:=new(pfloatdef,init(s80real));
 236 {$endif}
 237 {$ifdef SUPPORT_FIXED}
 238   s32fixeddef:=new(pfloatdef,init(f32bit));
 239 {$endif SUPPORT_FIXED}
 240   { some other definitions }
 241   voidpointerdef:=new(ppointerdef,initdef(voiddef));
 242   charpointerdef:=new(ppointerdef,initdef(cchardef));
 243   voidfarpointerdef:=new(ppointerdef,initfardef(voiddef));
 244   cfiledef:=new(pfiledef,inituntyped);
 245   registerdef:=oldregisterdef;
 246 end;
 247
 248
 249 end.
 250 {
 251   $Log$
 252   Revision 1.1  2002/02/19 08:23:36  sasu
 253   Initial revision
 254
 255   Revision 1.1  2000/07/13 06:29:55  michael
 256   + Initial import
 257
 258   Revision 1.34  2000/02/15 14:36:45  florian
 259     * disable FIXED data type per default
 260
 261   Revision 1.33  2000/02/09 13:23:00  peter
 262     * log truncated
 263
 264   Revision 1.32  2000/01/07 01:14:33  peter
 265     * updated copyright to 2000
 266
 267   Revision 1.31  1999/12/18 14:55:21  florian
 268     * very basic widestring support
 269
 270   Revision 1.30  1999/11/30 10:40:51  peter
 271     + ttype, tsymlist
 272
 273   Revision 1.29  1999/11/06 14:34:23  peter
 274     * truncated log to 20 revs
 275
 276   Revision 1.28  1999/09/16 23:05:55  florian
 277     * m68k compiler is again compilable (only gas writer, no assembler reader)
 278
 279   Revision 1.27  1999/08/13 14:24:17  pierre
 280     + stabs for classes and classref working,
 281       a class still needs an ^ to get that content of it,
 282       but the class fields inside a class don't result into an
 283       infinite loop anymore!
 284
 285   Revision 1.26  1999/08/03 22:03:07  peter
 286     * moved bitmask constants to sets
 287     * some other type/const renamings
 288
 289 }