development/compilers/freepascal/rtl/inc/objpash.inc

   1 {
   2     $Id$
   3     This file is part of the Free Pascal run time library.
   4     Copyright (c) 1999-2000 by the Free Pascal development team
   5
   6     This unit makes Free Pascal as much as possible Delphi compatible
   7
   8     See the file COPYING.FPC, included in this distribution,
   9     for details about the copyright.
  10
  11     This program is distributed in the hope that it will be useful,
  12     but WITHOUT ANY WARRANTY; without even the implied warranty of
  13     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  14
  15  **********************************************************************}
  16
  17 {*****************************************************************************
  18                             Basic Types/constants
  19 *****************************************************************************}
  20
  21     const
  22 {$ifdef NEWVMTOFFSET}
  23        vmtInstanceSize         = 0;
  24        vmtParent               = 8;
  25        { These were negative value's, but are now positive, else classes
  26          couldn't be used with shared linking which copies only all data from
  27          the .global directive and not the data before the directive (PFV) }
  28        vmtClassName            = 12;
  29        vmtDynamicTable         = 16;
  30        vmtMethodTable          = 20;
  31        vmtFieldTable           = 24;
  32        vmtTypeInfo             = 28;
  33        vmtInitTable            = 32;
  34        vmtAutoTable            = 36;
  35        vmtIntfTable            = 40;
  36        vmtMsgStrPtr            = 44;
  37        { methods }
  38        vmtMethodStart          = 48;
  39        vmtDestroy              = vmtMethodStart;
  40        vmtNewInstance          = vmtMethodStart+4;
  41        vmtFreeInstance         = vmtMethodStart+8;
  42        vmtSafeCallException    = vmtMethodStart+12;
  43        vmtDefaultHandler       = vmtMethodStart+16;
  44        vmtAfterConstruction    = vmtMethodStart+20;
  45        vmtBeforeDestruction    = vmtMethodStart+24;
  46        vmtDefaultHandlerStr    = vmtMethodStart+28;
  47 {$else}
  48        vmtMsgStrPtr            = -36;
  49        vmtIntfTable            = -32;
  50        vmtAutoTable            = -28;
  51        vmtInitTable            = -24;
  52        vmtTypeInfo             = -20;
  53        vmtFieldTable           = -16;
  54        vmtMethodTable          = -12;
  55        vmtDynamicTable         = -8;
  56        vmtClassName            = -4;
  57        vmtInstanceSize         = 0;
  58        vmtParent               = 8;
  59        vmtDestroy              = 12;
  60        vmtNewInstance          = 16;
  61        vmtFreeInstance         = 20;
  62        vmtSafeCallException    = 24;
  63        vmtDefaultHandler       = 28;
  64        vmtAfterConstruction    = 32;
  65        vmtBeforeDestruction    = 36;
  66        vmtDefaultHandlerStr    = 40;
  67 {$endif}
  68
  69     type
  70        { some pointer definitions }
  71        pshortstring = ^shortstring;
  72        plongstring  = ^longstring;
  73        pansistring  = ^ansistring;
  74        pwidestring  = ^widestring;
  75        // pstring   = pansistring;
  76        pextended    = ^extended;
  77        ppointer     = ^pointer;
  78
  79        { now the let's declare the base classes for the class object }
  80        { model                                                       }
  81        tobject = class;
  82        tclass  = class of tobject;
  83        pclass  = ^tclass;
  84
  85
  86        { to access the message table from outside }
  87        tmsgstrtable = record
  88           name : pshortstring;
  89           method : pointer;
  90        end;
  91
  92        pmsgstrtable = ^tmsgstrtable;
  93
  94        tstringmessagetable = record
  95           count : dword;
  96           msgstrtable : array[0..0] of tmsgstrtable;
  97        end;
  98
  99        pstringmessagetable = ^tstringmessagetable;
 100
 101        tobject = class
 102        public
 103           { please don't change the order of virtual methods, because      }
 104           { their vmt offsets are used by some assembler code which uses   }
 105           { hard coded addresses      (FK)                                 }
 106           constructor create;
 107           { the virtual procedures must be in THAT order }
 108           destructor destroy;virtual;
 109           class function newinstance : tobject;virtual;
 110           procedure freeinstance;virtual;
 111           function safecallexception(exceptobject : tobject;
 112             exceptaddr : pointer) : longint;virtual;
 113           procedure defaulthandler(var message);virtual;
 114
 115           procedure free;
 116           class function initinstance(instance : pointer) : tobject;
 117           procedure cleanupinstance;
 118           function classtype : tclass;
 119           class function classinfo : pointer;
 120           class function classname : shortstring;
 121           class function classnameis(const name : string) : boolean;
 122           class function classparent : tclass;
 123           class function instancesize : longint;
 124           class function inheritsfrom(aclass : tclass) : boolean;
 125           class function stringmessagetable : pstringmessagetable;
 126           { message handling routines }
 127           procedure dispatch(var message);
 128           procedure dispatchstr(var message);
 129
 130           class function methodaddress(const name : shortstring) : pointer;
 131           class function methodname(address : pointer) : shortstring;
 132           function fieldaddress(const name : shortstring) : pointer;
 133
 134           { new since Delphi 4 }
 135           procedure AfterConstruction;virtual;
 136           procedure BeforeDestruction;virtual;
 137
 138           { new for gtk, default handler for text based messages }
 139           procedure DefaultHandlerStr(var message);virtual;
 140
 141           { interface functions, I don't know if we need this }
 142           {
 143           function getinterface(const iid : tguid;out obj) : boolean;
 144           class function getinterfaceentry(const iid : tguid) : pinterfaceentry;
 145           class function getinterfacetable : pinterfacetable;
 146           }
 147        end;
 148
 149        TExceptProc = Procedure (Obj : TObject; Addr,Frame: Pointer);
 150
 151        { Exception object stack }
 152        PExceptObject = ^TExceptObject;
 153        TExceptObject = record
 154          FObject : TObject;
 155          Addr,
 156          Frame   : pointer;
 157          Next    : PExceptObject;
 158        end;
 159
 160        Const
 161           ExceptProc : TExceptProc = Nil;
 162
 163        Function RaiseList : PExceptObject;
 164
 165
 166 {*****************************************************************************
 167                               Variant Type
 168 *****************************************************************************}
 169
 170     Const
 171        varEmpty     = $0000;
 172        varNull      = $0001;
 173        varSmallint  = $0002;
 174        varInteger   = $0003;
 175        varSingle    = $0004;
 176        varDouble    = $0005;
 177        varCurrency  = $0006;
 178        varDate      = $0007;
 179        varOleStr    = $0008;
 180        varDispatch  = $0009;
 181        varError     = $000A;
 182        varBoolean   = $000B;
 183        varVariant   = $000C;
 184        varUnknown   = $000D;
 185        varByte      = $0011;
 186        varString    = $0100;
 187        varAny       = $0101;
 188        varTypeMask  = $0FFF;
 189        varArray     = $2000;
 190        varByRef     = $4000;
 191
 192        vtInteger    = 0;
 193        vtBoolean    = 1;
 194        vtChar       = 2;
 195        vtExtended   = 3;
 196        vtString     = 4;
 197        vtPointer    = 5;
 198        vtPChar      = 6;
 199        vtObject     = 7;
 200        vtClass      = 8;
 201        vtWideChar   = 9;
 202        vtPWideChar  = 10;
 203        vtAnsiString = 11;
 204        vtCurrency   = 12;
 205        vtVariant    = 13;
 206        vtInterface  = 14;
 207        vtWideString = 15;
 208        vtInt64      = 16;
 209        vtQWord      = 17;
 210
 211     Type
 212        PVarRec = ^TVarRec;
 213        TVarRec = record
 214          case VType : Longint of
 215            vtInteger    : (VInteger: Longint);
 216            vtBoolean    : (VBoolean: Boolean);
 217            vtChar       : (VChar: Char);
 218            vtExtended   : (VExtended: PExtended);
 219            vtString     : (VString: PShortString);
 220            vtPointer    : (VPointer: Pointer);
 221            vtPChar      : (VPChar: PChar);
 222            vtObject     : (VObject: TObject);
 223            vtClass      : (VClass: TClass);
 224 //           vtWideChar   : (VWideChar: WideChar);
 225 //           vtPWideChar  : (VPWideChar: PWideChar);
 226            vtAnsiString : (VAnsiString: Pointer);
 227 //           vtCurrency   : (VCurrency: PCurrency);
 228 //           vtVariant    : (VVariant: PVariant);
 229 //           vtInterface  : (VInterface: Pointer);
 230            vtWideString : (VWideString: Pointer);
 231            vtInt64      : (VInt64: PInt64);
 232            vtQWord      : (VQWord: PQWord);
 233        end;
 234 {
 235   $Log$
 236   Revision 1.1  2002/02/19 08:25:27  sasu
 237   Initial revision
 238
 239   Revision 1.1  2000/07/13 06:30:48  michael
 240   + Initial import
 241
 242   Revision 1.11  2000/06/22 18:05:56  michael
 243   + Modifications for exception support in sysutils. Mainly added
 244      RaiseList function.
 245
 246   Revision 1.10  2000/05/14 18:47:53  florian
 247     * TVarRec with Int64/QWord stuff extended
 248
 249   Revision 1.9  2000/04/24 11:11:50  peter
 250     * backtraces for exceptions are now only generated from the place of the
 251       exception
 252     * frame is also pushed for exceptions
 253     * raise statement enhanced with [,<frame>]
 254
 255   Revision 1.8  2000/02/09 16:59:31  peter
 256     * truncated log
 257
 258   Revision 1.7  2000/01/07 16:41:36  daniel
 259     * copyright 2000
 260
 261   Revision 1.6  2000/01/07 16:32:25  daniel
 262     * copyright 2000 added
 263
 264   Revision 1.5  1999/12/02 19:28:53  peter
 265     * public added to TObject
 266
 267   Revision 1.4  1999/08/09 22:20:03  peter
 268     * classes vmt changed to only positive addresses
 269     * sharedlib creation is working
 270
 271 }