mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-31 12:31:38 +01:00
336 lines
13 KiB
ObjectPascal
336 lines
13 KiB
ObjectPascal
{
|
|
$Id$
|
|
Copyright (c) 1998-2000 by Florian Klaempfl
|
|
|
|
Load the system unit, create required defs for systemunit
|
|
|
|
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 psystem;
|
|
interface
|
|
uses symtable;
|
|
|
|
procedure insertinternsyms(p : psymtable);
|
|
procedure insert_intern_types(p : psymtable);
|
|
|
|
procedure readconstdefs;
|
|
procedure createconstdefs;
|
|
|
|
implementation
|
|
|
|
uses
|
|
globtype,globals,symconst,tree;
|
|
|
|
procedure insertinternsyms(p : psymtable);
|
|
{
|
|
all intern procedures for system unit
|
|
}
|
|
begin
|
|
p^.insert(new(psyssym,init('CONCAT',in_concat_x)));
|
|
p^.insert(new(psyssym,init('WRITE',in_write_x)));
|
|
p^.insert(new(psyssym,init('WRITELN',in_writeln_x)));
|
|
p^.insert(new(psyssym,init('ASSIGNED',in_assigned_x)));
|
|
p^.insert(new(psyssym,init('READ',in_read_x)));
|
|
p^.insert(new(psyssym,init('READLN',in_readln_x)));
|
|
p^.insert(new(psyssym,init('OFS',in_ofs_x)));
|
|
p^.insert(new(psyssym,init('SIZEOF',in_sizeof_x)));
|
|
p^.insert(new(psyssym,init('TYPEOF',in_typeof_x)));
|
|
p^.insert(new(psyssym,init('LOW',in_low_x)));
|
|
p^.insert(new(psyssym,init('HIGH',in_high_x)));
|
|
p^.insert(new(psyssym,init('SEG',in_seg_x)));
|
|
p^.insert(new(psyssym,init('ORD',in_ord_x)));
|
|
p^.insert(new(psyssym,init('PRED',in_pred_x)));
|
|
p^.insert(new(psyssym,init('SUCC',in_succ_x)));
|
|
p^.insert(new(psyssym,init('EXCLUDE',in_exclude_x_y)));
|
|
p^.insert(new(psyssym,init('INCLUDE',in_include_x_y)));
|
|
p^.insert(new(psyssym,init('BREAK',in_break)));
|
|
p^.insert(new(psyssym,init('CONTINUE',in_continue)));
|
|
p^.insert(new(psyssym,init('DEC',in_dec_x)));
|
|
p^.insert(new(psyssym,init('INC',in_inc_x)));
|
|
p^.insert(new(psyssym,init('STR',in_str_x_string)));
|
|
p^.insert(new(psyssym,init('ASSERT',in_assert_x_y)));
|
|
p^.insert(new(psyssym,init('VAL',in_val_x)));
|
|
p^.insert(new(psyssym,init('ADDR',in_addr_x)));
|
|
end;
|
|
|
|
|
|
procedure insert_intern_types(p : psymtable);
|
|
{
|
|
all the types inserted into the system unit
|
|
}
|
|
var
|
|
{ several defs to simulate more or less C++ objects for GDB }
|
|
vmtdef : precorddef;
|
|
vmtarraydef : parraydef;
|
|
vmtsymtable : psymtable;
|
|
begin
|
|
{ Internal types }
|
|
p^.insert(new(ptypesym,initdef('formal',cformaldef)));
|
|
p^.insert(new(ptypesym,initdef('void',voiddef)));
|
|
p^.insert(new(ptypesym,initdef('byte',u8bitdef)));
|
|
p^.insert(new(ptypesym,initdef('word',u16bitdef)));
|
|
p^.insert(new(ptypesym,initdef('ulong',u32bitdef)));
|
|
p^.insert(new(ptypesym,initdef('longint',s32bitdef)));
|
|
p^.insert(new(ptypesym,initdef('qword',cu64bitdef)));
|
|
p^.insert(new(ptypesym,initdef('int64',cs64bitdef)));
|
|
p^.insert(new(ptypesym,initdef('char',cchardef)));
|
|
p^.insert(new(ptypesym,initdef('widechar',cwidechardef)));
|
|
p^.insert(new(ptypesym,initdef('shortstring',cshortstringdef)));
|
|
p^.insert(new(ptypesym,initdef('longstring',clongstringdef)));
|
|
p^.insert(new(ptypesym,initdef('ansistring',cansistringdef)));
|
|
p^.insert(new(ptypesym,initdef('widestring',cwidestringdef)));
|
|
p^.insert(new(ptypesym,initdef('openshortstring',openshortstringdef)));
|
|
p^.insert(new(ptypesym,initdef('boolean',booldef)));
|
|
p^.insert(new(ptypesym,initdef('void_pointer',voidpointerdef)));
|
|
p^.insert(new(ptypesym,initdef('char_pointer',charpointerdef)));
|
|
p^.insert(new(ptypesym,initdef('void_farpointer',voidfarpointerdef)));
|
|
p^.insert(new(ptypesym,initdef('openchararray',openchararraydef)));
|
|
p^.insert(new(ptypesym,initdef('file',cfiledef)));
|
|
p^.insert(new(ptypesym,initdef('s32real',s32floatdef)));
|
|
p^.insert(new(ptypesym,initdef('s64real',s64floatdef)));
|
|
p^.insert(new(ptypesym,initdef('s80real',s80floatdef)));
|
|
p^.insert(new(ptypesym,initdef('s32fixed',s32fixeddef)));
|
|
{ Add a type for virtual method tables in lowercase }
|
|
{ so it isn't reachable! }
|
|
vmtsymtable:=new(psymtable,init(recordsymtable));
|
|
vmtdef:=new(precorddef,init(vmtsymtable));
|
|
pvmtdef:=new(ppointerdef,initdef(vmtdef));
|
|
vmtsymtable^.insert(new(pvarsym,initdef('parent',pvmtdef)));
|
|
vmtsymtable^.insert(new(pvarsym,initdef('length',globaldef('longint'))));
|
|
vmtsymtable^.insert(new(pvarsym,initdef('mlength',globaldef('longint'))));
|
|
vmtarraydef:=new(parraydef,init(0,1,s32bitdef));
|
|
vmtarraydef^.elementtype.setdef(voidpointerdef);
|
|
vmtsymtable^.insert(new(pvarsym,initdef('__pfn',vmtarraydef)));
|
|
p^.insert(new(ptypesym,initdef('__vtbl_ptr_type',vmtdef)));
|
|
p^.insert(new(ptypesym,initdef('pvmt',pvmtdef)));
|
|
vmtarraydef:=new(parraydef,init(0,1,s32bitdef));
|
|
vmtarraydef^.elementtype.setdef(pvmtdef);
|
|
p^.insert(new(ptypesym,initdef('vtblarray',vmtarraydef)));
|
|
insertinternsyms(p);
|
|
{ Normal types }
|
|
p^.insert(new(ptypesym,initdef('SINGLE',s32floatdef)));
|
|
p^.insert(new(ptypesym,initdef('DOUBLE',s64floatdef)));
|
|
p^.insert(new(ptypesym,initdef('EXTENDED',s80floatdef)));
|
|
p^.insert(new(ptypesym,initdef('REAL',s64floatdef)));
|
|
{$ifdef i386}
|
|
p^.insert(new(ptypesym,initdef('COMP',new(pfloatdef,init(s64comp)))));
|
|
{$endif}
|
|
p^.insert(new(ptypesym,initdef('POINTER',voidpointerdef)));
|
|
p^.insert(new(ptypesym,initdef('FARPOINTER',voidfarpointerdef)));
|
|
p^.insert(new(ptypesym,initdef('SHORTSTRING',cshortstringdef)));
|
|
p^.insert(new(ptypesym,initdef('LONGSTRING',clongstringdef)));
|
|
p^.insert(new(ptypesym,initdef('ANSISTRING',cansistringdef)));
|
|
p^.insert(new(ptypesym,initdef('WIDESTRING',cwidestringdef)));
|
|
p^.insert(new(ptypesym,initdef('BOOLEAN',booldef)));
|
|
p^.insert(new(ptypesym,initdef('BYTEBOOL',booldef)));
|
|
p^.insert(new(ptypesym,initdef('WORDBOOL',new(porddef,init(bool16bit,0,1)))));
|
|
p^.insert(new(ptypesym,initdef('LONGBOOL',new(porddef,init(bool32bit,0,1)))));
|
|
p^.insert(new(ptypesym,initdef('CHAR',cchardef)));
|
|
p^.insert(new(ptypesym,initdef('WIDECHAR',cwidechardef)));
|
|
p^.insert(new(ptypesym,initdef('TEXT',new(pfiledef,inittext))));
|
|
p^.insert(new(ptypesym,initdef('CARDINAL',u32bitdef)));
|
|
p^.insert(new(ptypesym,initdef('FIXED',new(pfloatdef,init(f32bit)))));
|
|
p^.insert(new(ptypesym,initdef('FIXED16',new(pfloatdef,init(f16bit)))));
|
|
p^.insert(new(ptypesym,initdef('QWORD',cu64bitdef)));
|
|
p^.insert(new(ptypesym,initdef('INT64',cs64bitdef)));
|
|
p^.insert(new(ptypesym,initdef('TYPEDFILE',new(pfiledef,inittypeddef(voiddef)))));
|
|
end;
|
|
|
|
|
|
procedure readconstdefs;
|
|
{
|
|
Load all default definitions for consts from the system unit
|
|
}
|
|
begin
|
|
u8bitdef:=porddef(globaldef('byte'));
|
|
u16bitdef:=porddef(globaldef('word'));
|
|
u32bitdef:=porddef(globaldef('ulong'));
|
|
s32bitdef:=porddef(globaldef('longint'));
|
|
cu64bitdef:=porddef(globaldef('qword'));
|
|
cs64bitdef:=porddef(globaldef('int64'));
|
|
cformaldef:=pformaldef(globaldef('formal'));
|
|
voiddef:=porddef(globaldef('void'));
|
|
cchardef:=porddef(globaldef('char'));
|
|
cwidechardef:=porddef(globaldef('char'));
|
|
cshortstringdef:=pstringdef(globaldef('shortstring'));
|
|
clongstringdef:=pstringdef(globaldef('longstring'));
|
|
cansistringdef:=pstringdef(globaldef('ansistring'));
|
|
cwidestringdef:=pstringdef(globaldef('widestring'));
|
|
openshortstringdef:=pstringdef(globaldef('openshortstring'));
|
|
openchararraydef:=parraydef(globaldef('openchararray'));
|
|
s32floatdef:=pfloatdef(globaldef('s32real'));
|
|
s64floatdef:=pfloatdef(globaldef('s64real'));
|
|
s80floatdef:=pfloatdef(globaldef('s80real'));
|
|
s32fixeddef:=pfloatdef(globaldef('s32fixed'));
|
|
booldef:=porddef(globaldef('boolean'));
|
|
voidpointerdef:=ppointerdef(globaldef('void_pointer'));
|
|
charpointerdef:=ppointerdef(globaldef('char_pointer'));
|
|
voidfarpointerdef:=ppointerdef(globaldef('void_farpointer'));
|
|
cfiledef:=pfiledef(globaldef('file'));
|
|
pvmtdef:=ppointerdef(globaldef('pvmt'));
|
|
end;
|
|
|
|
|
|
procedure createconstdefs;
|
|
{
|
|
Create all default definitions for consts for the system unit
|
|
}
|
|
var
|
|
oldregisterdef : boolean;
|
|
begin
|
|
{ create definitions for constants }
|
|
oldregisterdef:=registerdef;
|
|
registerdef:=false;
|
|
cformaldef:=new(pformaldef,init);
|
|
voiddef:=new(porddef,init(uvoid,0,0));
|
|
u8bitdef:=new(porddef,init(u8bit,0,255));
|
|
u16bitdef:=new(porddef,init(u16bit,0,65535));
|
|
u32bitdef:=new(porddef,init(u32bit,0,$ffffffff));
|
|
s32bitdef:=new(porddef,init(s32bit,$80000000,$7fffffff));
|
|
cu64bitdef:=new(porddef,init(u64bit,0,0));
|
|
cs64bitdef:=new(porddef,init(s64bit,0,0));
|
|
booldef:=new(porddef,init(bool8bit,0,1));
|
|
cchardef:=new(porddef,init(uchar,0,255));
|
|
cwidechardef:=new(porddef,init(uwidechar,0,65535));
|
|
cshortstringdef:=new(pstringdef,shortinit(255));
|
|
{ should we give a length to the default long and ansi string definition ?? }
|
|
clongstringdef:=new(pstringdef,longinit(-1));
|
|
cansistringdef:=new(pstringdef,ansiinit(-1));
|
|
cwidestringdef:=new(pstringdef,wideinit(-1));
|
|
{ length=0 for shortstring is open string (needed for readln(string) }
|
|
openshortstringdef:=new(pstringdef,shortinit(0));
|
|
openchararraydef:=new(parraydef,init(0,-1,s32bitdef));
|
|
parraydef(openchararraydef)^.elementtype.setdef(cchardef);
|
|
{$ifdef i386}
|
|
s32floatdef:=new(pfloatdef,init(s32real));
|
|
s64floatdef:=new(pfloatdef,init(s64real));
|
|
s80floatdef:=new(pfloatdef,init(s80real));
|
|
{$endif}
|
|
{$ifdef m68k}
|
|
s32floatdef:=new(pfloatdef,init(s32real));
|
|
s64floatdef:=new(pfloatdef,init(s64real));
|
|
if (cs_fp_emulation in aktmoduleswitches) then
|
|
s80floatdef:=new(pfloatdef,init(s32real))
|
|
else
|
|
s80floatdef:=new(pfloatdef,init(s80real));
|
|
{$endif}
|
|
s32fixeddef:=new(pfloatdef,init(f32bit));
|
|
{ some other definitions }
|
|
voidpointerdef:=new(ppointerdef,initdef(voiddef));
|
|
charpointerdef:=new(ppointerdef,initdef(cchardef));
|
|
voidfarpointerdef:=new(ppointerdef,initfardef(voiddef));
|
|
cfiledef:=new(pfiledef,inituntyped);
|
|
registerdef:=oldregisterdef;
|
|
end;
|
|
|
|
|
|
end.
|
|
{
|
|
$Log$
|
|
Revision 1.32 2000-01-07 01:14:33 peter
|
|
* updated copyright to 2000
|
|
|
|
Revision 1.31 1999/12/18 14:55:21 florian
|
|
* very basic widestring support
|
|
|
|
Revision 1.30 1999/11/30 10:40:51 peter
|
|
+ ttype, tsymlist
|
|
|
|
Revision 1.29 1999/11/06 14:34:23 peter
|
|
* truncated log to 20 revs
|
|
|
|
Revision 1.28 1999/09/16 23:05:55 florian
|
|
* m68k compiler is again compilable (only gas writer, no assembler reader)
|
|
|
|
Revision 1.27 1999/08/13 14:24:17 pierre
|
|
+ stabs for classes and classref working,
|
|
a class still needs an ^ to get that content of it,
|
|
but the class fields inside a class don't result into an
|
|
infinite loop anymore!
|
|
|
|
Revision 1.26 1999/08/03 22:03:07 peter
|
|
* moved bitmask constants to sets
|
|
* some other type/const renamings
|
|
|
|
Revision 1.25 1999/07/05 20:13:17 peter
|
|
* removed temp defines
|
|
|
|
Revision 1.24 1999/07/01 15:49:20 florian
|
|
* int64/qword type release
|
|
+ lo/hi for int64/qword
|
|
|
|
Revision 1.23 1999/05/12 00:19:53 peter
|
|
* removed R_DEFAULT_SEG
|
|
* uniform float names
|
|
|
|
Revision 1.22 1999/05/06 09:05:23 peter
|
|
* generic write_float and str_float
|
|
* fixed constant float conversions
|
|
|
|
Revision 1.21 1999/04/26 18:28:15 peter
|
|
* better read/write array
|
|
|
|
Revision 1.20 1999/04/17 13:12:20 peter
|
|
* addr() internal
|
|
|
|
Revision 1.19 1999/04/07 15:31:12 pierre
|
|
* all formaldefs are now a sinlge definition
|
|
cformaldef (this was necessary for double_checksum)
|
|
+ small part of double_checksum code
|
|
|
|
Revision 1.18 1999/03/26 00:05:40 peter
|
|
* released valintern
|
|
+ deffile is now removed when compiling is finished
|
|
* ^( compiles now correct
|
|
+ static directive
|
|
* shrd fixed
|
|
|
|
Revision 1.17 1999/03/16 17:52:54 jonas
|
|
* changes for internal Val code (do a "make cycle OPT=-dvalintern" to test)
|
|
* in cgi386inl: also range checking for subrange types (compile with "-dreadrangecheck")
|
|
* in cgai386: also small fixes to emitrangecheck
|
|
|
|
Revision 1.16 1999/03/02 02:56:17 peter
|
|
+ stabs support for binary writers
|
|
* more fixes and missing updates from the previous commit :(
|
|
|
|
Revision 1.15 1998/12/30 22:15:51 peter
|
|
+ farpointer type
|
|
* absolutesym now also stores if its far
|
|
|
|
Revision 1.14 1998/12/11 00:03:40 peter
|
|
+ globtype,tokens,version unit splitted from globals
|
|
|
|
Revision 1.13 1998/12/10 09:47:25 florian
|
|
+ basic operations with int64/qord (compiler with -dint64)
|
|
+ rtti of enumerations extended: names are now written
|
|
|
|
Revision 1.12 1998/11/27 14:50:45 peter
|
|
+ open strings, $P switch support
|
|
|
|
Revision 1.11 1998/11/16 10:18:09 peter
|
|
* fixes for ansistrings
|
|
|
|
Revision 1.10 1998/11/09 11:44:36 peter
|
|
+ va_list for printf support
|
|
|
|
Revision 1.9 1998/11/05 12:02:54 peter
|
|
* released useansistring
|
|
* removed -Sv, its now available in fpc modes
|
|
|
|
}
|