paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-07-06 07:26:30 +02:00
Code Issues Packages Projects Releases Wiki Activity
1cf4d20b51
fpc/packages/extra/os2units/som/som.pas
yuri 6c9bae4082 * Fixed compilation
2004-12-23 05:16:31 +00:00

1544 lines
60 KiB
ObjectPascal
Raw Blame History

{
$Id$
Copyright (c) 1994-1996 by International Business Machines Corporation
Copyright (c) 1997 Antony T Curtis.
Copyright (c) 2002-2005 by Yuri Prokushev (prokushev@freemail.ru)
System Object Model Run-time library API (SOM.DLL)
This program is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License (LGPL) 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 Library General Public License for more details. You should
have received a copy of the GNU Library General Public License along
with this program; if not, write to the Free Software Foundation, Inc.,
59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
**********************************************************************}
Unit SOM;
Interface
{$mode objfpc}
{$warning This units doesn't work because FPC/2 doesn't implements external vars}
{$warning This code is alpha!}
//uses
// SOMTypes;
var
{$warning support of external vars required}
SOM_MajorVersion, SOM_MinorVersion :Longint; (* SOM Version Numbers *)
//³ 00070 ³ SOM_MajorVersion
//³ 00071 ³ SOM_MinorVersion
{$warning support of external vars required}
SOM_MaxThreads :Longint; // ³ 00095 ³ SOM_MaxThreads (* SOM Thread Support *)
type
Flags =Longint;
type
TSOMObject = Pointer;
SOMClassType = Pointer;
SOMMSingleInstanceType = Pointer;
SOMClassMgrType = Pointer;
SOMClassPtr = ^SOMClassType;
PSOMClass = ^SOMClassType;
PSOMObject = ^TSOMObject;
CORBAObjectType = TSOMObject; (* in SOM, a CORBA object is a SOM object *)
somToken =Pointer; (* Uninterpretted value *)
somId =^PChar;
somIdPtr =^somId;
PsomToken =^somToken; (* Uninterpretted value *)
somMToken =somToken;
somDToken =somToken;
somMTokenPtr =^somMToken;
somDTokenPtr =^somDToken;
type
ImplId =^PChar;
RepositoryId = PChar;
AttributeDef_AttributeMode = Cardinal;
OperationDef_OperationMode = Longint;
ParameterDef_ParameterMode = Cardinal;
somMethodPtr =Pointer;
somBooleanVector =^Byte;
somCtrlInfo =somToken;
somSharedMethodData =somToken;
somSharedMethodDataPtr=^somSharedMethodData;
somClassInfoPtr =^somClassInfo;
somClassInfo =somToken;
Identifier =PChar; (* CORBA 7.5.1, p. 129 *)
TypeCode = pointer;
(* CORBA 5.7, p.89 *)
any = record
_type : TypeCode;
_value : Pointer;
end;
NamedValue =record
name : Identifier;
argument : any;
len : Longint;
arg_modes : Flags;
end;
(* -- Method/Data Tokens -- For locating methods and data members. *)
somRdAppType =LongInt; (* method signature code -- see def below *)
somFloatMap =Array[0..13] of LongInt; (* float map -- see def below *)
somFloatMapPtr =^somFloatMapPtr;
somMethodInfoStruct =record
callType :somRdAppType;
va_listSize :Longint;
float_map :somFloatMapPtr;
end;
somMethodInfo =somMethodInfoStruct;
somMethodInfoPtr =^somMethodInfo;
somMethodDataStruct =record
id :somId;
ctype :Longint; (* 0=static, 1=dynamic 2=nonstatic *)
descriptor :somId; (* for use with IR interfaces *)
mToken :somMToken; (* NULL for dynamic methods *)
method :somMethodPtr; (* depends on resolution context *)
shared :somSharedMethodDataPtr;
end;
somMethodData =somMethodDataStruct;
somMethodDataPtr =^somMethodDataStruct;
somMethodProc =Procedure(somSelf:TSOMObject);
somMethodProcPtr =^somMethodProc;
(*---------------------------------------------------------------------
* C++-style constructors are called initializers in SOM. Initializers
* are methods that receive a pointer to a somCtrlStruct as an argument.
*)
somInitInfo =record
cls :SOMClassType;(* the class whose introduced data is to be initialized *)
defaultInit :somMethodProc;
defaultCopyInit :somMethodProc;
defaultConstCopyInit:somMethodProc;
defaultNCArgCopyInit:somMethodProc;
dataOffset :Longint;
legacyInit :somMethodProc;
end;
somDestructInfo =record
cls :SOMClassType;(* the class whose introduced data is to be destroyed *)
defaultDestruct :somMethodProc;
dataOffset :Longint;
legacyUninit :somMethodProc;
end;
somAssignInfo =record
cls :SOMClassType;(* the class whose introduced data is to be assigned *)
defaultAssign :somMethodProc;
defaultConstAssign :somMethodProc;
defaultNCArgAssign :somMethodProc;
udaAssign :somMethodProc;
udaConstAssign :somMethodProc;
dataOffset :Longint;
end;
_IDL_SEQUENCE_octet = record
_maximum : Cardinal;
_length : Cardinal;
_buffer : ^Byte;
end;
ReferenceData =_IDL_SEQUENCE_octet;
(*
* A special info access structure pointed to by
* the parentMtab entry of somCClassDataStructure.
*)
somTD_somRenewNoInitNoZeroThunk =Procedure(var buf); cdecl;
somInitInfoPtr =^somInitInfo;
somInitCtrlStruct =record
mask :somBooleanVector;(* an array of booleans to control ancestor calls *)
info :somInitInfoPtr; (* an array of structs *)
infoSize :Longint; (* increment for info access *)
ctrlInfo :somCtrlInfo;
end;
somInitCtrl =somInitCtrlStruct;
som3InitCtrl =somInitCtrlStruct;
somDestructInfoPtr =^somDestructInfo;
somDestructCtrlStruct =record
mask :somBooleanVector;(* an array of booleans to control ancestor calls *)
info :somDestructInfoPtr;(* an array of structs *)
infoSize :Longint; (* increment for info access *)
ctrlInfo :somCtrlInfo;
end;
somDestructCtrl =somDestructCtrlStruct;
som3DestructCtrl =somDestructCtrlStruct;
somAssignInfoPtr =^somAssignInfo;
somAssignCtrlStruct =record
mask :somBooleanVector;(* an array of booleans to control ancestor calls *)
info :somAssignInfoPtr;(* an array of structs *)
infoSize :Longint; (* increment for info access *)
ctrlInfo :somCtrlInfo;
end;
somAssignCtrl =somAssignCtrlStruct;
som3AssignCtrl =somAssignCtrlStruct;
(*----------------------------------------------------------------------
* The Class Data Structures -- these are used to implement static
* method and data interfaces to SOM objects.
*)
type
(* -- (Generic) Class data Structure *)
somClassDataStructure =record
classObject :SOMClassType; (* changed by shadowing *)
tokens :Array[0..0] of somToken; (* method tokens, etc. *)
end;
somClassDataStructurePtr=^somClassDataStructure;
somInitCtrlPtr =^somInitCtrl;
somDestructCtrlPtr =^somDestructCtrl;
somAssignCtrlPtr =^somAssignCtrl;
(* -- For building lists of method tables *)
somMethodTabPtr =^somMethodTab;
somMethodTabs =^somMethodTabList;
somMethodTabList =record
mtab :somMethodTabPtr;
next :somMethodTabs;
end;
somParentMtabStruct =record
mtab :somMethodTabPtr; (* this class' mtab -- changed by shadowing *)
next :somMethodTabs; (* the parent mtabs -- unchanged by shadowing *)
classObject :SOMClassType; (* unchanged by shadowing *)
somRenewNoInitNoZeroThunk:somTD_somRenewNoInitNoZeroThunk; (* changed by shadowing *)
instanceSize :Longint; (* changed by shadowing *)
initializers :somMethodProcPtr; (* resolved initializer array in releaseorder *)
resolvedMTokens :somMethodProcPtr; (* resolved methods *)
initCtrl :somInitCtrl; (* these fields are filled in if somDTSClass&2 is on *)
destructCtrl :somDestructCtrl;
assignCtrl :somAssignCtrl;
embeddedTotalCount :Longint;
hierarchyTotalCount :Longint;
unused :Longint;
end;
somParentMtabStructPtr=^somParentMtabStruct;
(*
* (Generic) Auxiliary Class Data Structure
*)
somCClassDataStructure=record
parentMtab :somParentMtabStructPtr;
instanceDataToken :somDToken;
wrappers :Array[0..0] of somMethodProc; (* for valist methods *)
end;
somCClassDataStructurePtr=^somCClassDataStructure;
(*----------------------------------------------------------------------
* The Method Table Structure
*)
(* -- to specify an embedded object (or array of objects). *)
somEmbeddedObjStructPtr=^somEmbeddedObjStruct;
somEmbeddedObjStruct =record
copp :SOMClassType; (* address of class of object ptr *)
cnt :Longint; (* object count *)
offset :Longint; (* Offset to pointer (to embedded objs) *)
end;
somMethodTabStruct =record
classObject :SOMClassType;
classInfo :somClassInfoPtr;
className :PChar;
instanceSize :Longint;
dataAlignment :Longint;
mtabSize :Longint;
protectedDataOffset :Longint; (* from class's introduced data *)
protectedDataToken :somDToken;
embeddedObjs :somEmbeddedObjStructPtr;
(* remaining structure is opaque *)
entries :Array[0..0] of somMethodProc;
end;
somMethodTab =somMethodTabStruct;
(* -- For building lists of class objects *)
somClasses =^somClassList;
somClassList =record
cls :SOMClassType;
next :somClasses;
end;
(* -- For building lists of objects *)
somObjects =^somObjectList;
somObjectList =record
obj :TSOMObject;
next :somObjects;
end;
(*----------------------------------------------------------------------
* Method Stubs -- Signature Support
*
*
* This section defines the structures used to pass method signature
* ingo to the runtime. This supports selection of generic apply stubs
* and runtime generation of redispatchstubs when these are needed. The
* information is registered with the runtime when methods are defined.
*
* When calling somAddStaticMethod, if the redispatchStub is -1, then a
* pointer to a struct of type somApRdInfo is passed as the applyStub.
* Otherwise, the passed redispatchstub and applystub are taken as given.
* When calling somAddDynamicMethod, an actual apply stub must be passed.
* Redispatch stubs for dynamic methods are not available, nor is
* automated support for dynamic method apply stubs. The following
* atructures only appropriate in relation to static methods.
*
* In SOMr2, somAddStaticMethod can be called with an actual redispatchstub
* and applystub *ONLY* if the method doesn't return a structure. Recall
* that no SOMr1 methods returned structures, so SOMr1 binaries obey this
* restriction. The reason for this rule is that SOMr2 *may* use thunks,
* and thunks need to know if a structure is returned. We therefore assume
* that if no signature information is provided for a method through the
* somAddStaticMethod interface, then the method returns a scalar.
*
* If a structure is returned, then a -1 *must* be passed to
* somAddStaticMethod as a redispatchstub. In any case, if a -1 is passed,
* then this means that the applystub actually points to a structure of type
* somApRdInfo. This structure is used to hold and access signature
* information encoded as follows.
*
* If the somApRdInfo pointer is NULL, then, if the runtime was built with
* SOM_METHOD_STUBS defined, a default signature is assumed (no arguments,
* and no structure returned); otherwise, the stubs are taken as
* somDefaultMethod (which produces a runtime error when used) if dynamic
* stubs are not available.
*
* If the somApRdInfo pointer is not NULL, then the structure it points to can
* either include (non-null) redispatch and applystubs (the method is then
* assumed to return a structure), or null stubs followed by information needed
* to generate necessary stubs dynamically.
*)
somApRdInfoStruct =record
rdStub :somMethodProc;
apStub :somMethodProc;
stubInfo :somMethodInfoPtr;
end;
somApRdInfo =somApRdInfoStruct;
(*
* Values for somRdAppType are generated by summing one from column A and one
* from column B of the following constants:
*)
(* Column A: return type *)
const
SOMRdRetsimple = 0; (* Return type is a non-float fullword *)
SOMRdRetfloat = 2; (* Return type is (single) float *)
SOMRdRetdouble = 4; (* Return type is double *)
SOMRdRetlongdouble = 6; (* Return type is long double *)
SOMRdRetaggregate = 8; (* Return type is struct or union *)
SOMRdRetbyte =10; (* Return type is a byte *)
SOMRdRethalf =12; (* Return type is a (2 byte) halfword *)
(* Column B: are there any floating point scalar arguments? *)
SOMRdNoFloatArgs = 0;
SOMRdFloatArgs = 1;
(* A somFloatMap is only needed on RS/6000 *)
(*
* This is an array of offsets for up to the first 13 floating point arguments.
* If there are fewer than 13 floating point arguments, then there will be
* zero entries following the non-zero entries which represent the float args.
* A non-zero entry signals either a single- or a double-precision floating point
* argument. For a double-precision argument, the entry is the stack
* frame offset. For a single-precision argument the entry is the stack
* frame offset + 1. For the final floating point argument, add 2 to the
* code that would otherwise be used.
*)
SOMFMSingle = 1; (* add to indicate single-precision *)
SOMFMLast = 2; (* add to indicate last floating point arg *)
const
SOM_SCILEVEL = 4;
(* The SCI includes the following information:
*
* The address of a class's ClassData structure is passed.
* This structure should have the external name,
* <className>ClassData. The classObject field should be NULL
* (if it is not NULL, then a new class will not be built). somBuildClass will
* set this field to the address of the new class object when it is built.
*
* The address of the class's auxiliary ClassData structure is passed.
* Thi structure should have the external name,
* <className>CClassData. The parentMtab field will be set by somBuildClass.
* This field often allows method calls to a class object to be avoided.
*
* The other structures referenced by the static class information (SCI)
* are used to:
*)
(*
* to specify a static method. The methodId used here must be
* a simple name (i.e., no colons). In all other cases,
* where a somId is used to identify a registered method,
* the somId can include explicit scoping. An explicitly-scoped
* method name is called a method descriptor. For example,
* the method introduced by TSOMObject as somGetClass has the
* method descriptor "TSOMObject::somGetClass". When a
* class is contained in an IDL module, the descriptor syntax
* <moduleName>::<className>::<methodName> can be used. Method
* descriptors can be useful when a class supports different methods
* that have the same name (note: IDL prevents this from occuring
* statically, but SOM itself has no problems with this).
*)
type
somStaticMethodStruct =record
classData :somMTokenPtr;
methodId :somIdPtr; (* this must be a simple name (no colons) *)
methodDescriptor :somIdPtr;
method :somMethodPtr;//somMethodProc;
redispatchStub :somMethodPtr;//somMethodProc;
applyStub :somMethodPtr;//somMethodProc;
end;
somStaticMethod_t =somStaticMethodStruct;
somStaticMethod_p =^somStaticMethod_t;
(* to specify an overridden method *)
somOverideMethodStruct=record
methodId :somIdPtr; (* this can be a method descriptor *)
method :somMethodPtr;//somMethodProc;
end;
somOverrideMethod_t =somOverideMethodStruct;
somOverrideMethod_p =^somOverrideMethod_t;
(* to inherit a specific parent's method implementation *)
somInheritedMethodStruct=record
methodId :somIdPtr; (* identify the method *)
parentNum :Longint; (* identify the parent *)
mToken :somMTokenPtr; (* for parentNumresolve *)
end;
somInheritedMethod_t =somInheritedMethodStruct;
somInheritedMethod_p =^somInheritedMethod_t;
(* to register a method that has been moved from this *)
(* class <cls> upwards in the class hierachy to class <dest> *)
somMigratedMethodStruct=record
clsMToken :somMTokenPtr;
(* points into the <cls> classdata structure *)
(* the method token in <dest> will copied here *)
destMToken :somMTokenPtr;
(* points into the <dest> classdata structure *)
(* the method token here will be copied to <cls> *)
end;
somMigratedMethod_t =somMigratedMethodStruct;
somMigratedMethod_p =^somMigratedMethod_t;
(* to specify non-internal data *)
somNonInternalDataStruct=record
classData :somDTokenPtr;
basisForDataOffset :PChar;
end;
somNonInternalData_t =somNonInternalDataStruct;
somNonInternalData_p =^somNonInternalData_t;
(* to specify a "procedure" or "classdata" *)
somProcMethodsStruct =record
classData :somMethodProcPtr;
pEntry :somMethodProc;
end;
somProcMethods_t =somProcMethodsStruct;
somProcMethods_p =^somProcMethods_t;
(* to specify a general method "action" using somMethodStruct *)
(*
the type of action is specified by loading the type field of the
somMethodStruct. There are three bit fields in the overall type:
action (in type & 0xFF)
0: static -- (i.e., virtual) uses somAddStaticMethod
1: dynamic -- uses somAddDynamicMethod (classData==0)
2: nonstatic -- (i.e., nonvirtual) uses somAddMethod
3: udaAssign -- registers a method as the udaAssign (but doesn't add the method)
4: udaConstAssign -- like 3, this doesn't add the method
5: somClassResolve Override (using the class pointed to by *classData)
6: somMToken Override (using the method token pointed to by methodId)
(note: classData==0 for this)
7: classAllocate -- indicates the default heap allocator for this class.
If classData == 0, then method is the code address (or NULL)
If classData != 0, then *classData is the code address.
No other info required (or used)
8: classDeallocate -- like 7, but indicates the default heap deallocator.
9: classAllocator -- indicates a non default heap allocator for this class.
like 7, but a methodDescriptor can be given.
=== the following is not currently supported ===
binary data access -- in (type & 0x100), valid for actions 0,1,2,5,6
0: the method procedure doesn't want binary data access
1: the method procedure does want binary data access
aggregate return -- in (type & 0x200), used when binary data access requested
0: method procedure doesn't return a structure
1: method procedure does return a structure
*)
somMethodStruct =record
mtype :Longint;
classData :somMTokenPtr;
methodId :somIdPtr;
methodDescriptor :somIdPtr;
method :somMethodProc;
redispatchStub :somMethodProc;
applyStub :somMethodProc;
end;
somMethods_t =somMethodStruct;
somMethods_p =^somMethods_t;
(* to specify a varargs function *)
somVarargsFuncsStruct =record
classData :somMethodProcPtr;
vEntry :somMethodProc;
end;
somVarargsFuncs_t =somVarargsFuncsStruct;
somVarargsFuncs_p =^somVarargsFuncs_t;
(* to specify dynamically computed information (incl. embbeded objs) *)
somDynamicSCIPtr =^somDynamicSciPtr;
somDynamicSCI =record
version :Longint; (* 1 for now *)
instanceDataSize :Longint; (* true size (incl. embedded objs) *)
dataAlignment :Longint; (* true alignment *)
embeddedObjs :somEmbeddedObjStructPtr; (* array end == null copp *)
end;
(*
to specify a DTS class, use the somDTSClass entry in the following
data structure. This entry is a bit vector interpreted as follows:
(somDTSClass & 0x0001) == the class is a DTS C++ class
(somDTSClass & 0x0002) == the class wants the initCtrl entries
of the somParentMtabStruct filled in.
*)
(*
* The Static Class Info Structure passed to somBuildClass
*)
somStaticClassInfoStruct=record
layoutVersion :Longint; (* this struct defines layout version SOM_SCILEVEL *)
numStaticMethods :Longint; (* count of smt entries *)
numStaticOverrides :Longint; (* count of omt entries *)
numNonInternalData :Longint; (* count of nit entries *)
numProcMethods :Longint; (* count of pmt entries *)
numVarargsFuncs :Longint; (* count of vft entries *)
majorVersion :Longint;
minorVersion :Longint;
instanceDataSize :Longint; (* instance data introduced by this class *)
maxMethods :Longint; (* count numStaticMethods and numMethods *)
numParents :Longint;
classId :somId;
explicitMetaId :somId;
implicitParentMeta :Longint;
parents :somIdPtr;
cds :somClassDataStructurePtr;
ccds :somCClassDataStructurePtr;
smt :somStaticMethod_p; (* basic "static" methods for mtab *)
omt :somOverrideMethod_p; (* overrides for mtab *)
nitReferenceBase :PChar;
nit :somNonInternalData_p; (* datatokens for instance data *)
pmt :somProcMethods_p; (* Arbitrary ClassData members *)
vft :somVarargsFuncs_p; (* varargs stubs *)
cif :pointer{^somTP_somClassInitFunc}; (* class init function *)
(* end of layout version 1 *)
(* begin layout version 2 extensions *)
dataAlignment :Longint; (* the desired byte alignment for instance data *)
(* end of layout version 2 *)
//#define SOMSCIVERSION 1
(* begin layout version 3 extensions *)
numDirectInitClasses:Longint;
directInitClasses :somIdPtr;
numMethods :Longint; (* general (including nonstatic) methods for mtab *)
mt :somMethods_p;
protectedDataOffset :Longint; (* access = resolve(instanceDataToken) + offset *)
somSCIVersion :Longint; (* used during development. currently = 1 *)
numInheritedMethods :Longint;
imt :somInheritedMethod_p; (* inherited method implementations *)
numClassDataEntries :Longint; (* should always be filled in *)
classDataEntryNames :somIdPtr; (* either NULL or ptr to an array of somIds *)
numMigratedMethods :Longint;
mmt :somMigratedMethod_p; (* migrated method implementations *)
numInitializers :Longint; (* the initializers for this class *)
initializers :somIdPtr; (* in order of release *)
somDTSClass :Longint; (* used to identify a DirectToSOM class *)
dsci :somDynamicSCIPtr; (* used to register dynamically computed info *)
(* end of layout version 3 *)
end;
somStaticClassInfo =somStaticClassInfoStruct;
somStaticClassInfoPtr =^somStaticClassInfoStruct;
type
(*----------------------------------------------------------------------
* Typedefs for pointers to functions
*)
Contained_Description = record
name : Identifier;
value : any;
end;
InterfaceDef_FullInterfaceDescription = record
name : Identifier;
id, defined_in : RepositoryId;
{operation : IDL_SEQUENCE_OperationDef_OperationDescription;
attributes : IDL_SEQUENCE_AttributeDef_AttributeDescription;}
end;
InterfaceDef_InterfaceDescription = record
name : Identifier;
id, defined_in : RepositoryId;
end;
(* CORBA 7.6.1, p.139 plus 5.7, p.89 enum Data Type Mapping *)
type
TCKind = Cardinal;
const
TypeCode_tk_null = 1;
TypeCode_tk_void = 2;
TypeCode_tk_short = 3;
TypeCode_tk_long = 4;
TypeCode_tk_ushort = 5;
TypeCode_tk_ulong = 6;
TypeCode_tk_float = 7;
TypeCode_tk_double = 8;
TypeCode_tk_boolean = 9;
TypeCode_tk_char = 10;
TypeCode_tk_octet = 11;
TypeCode_tk_any = 12;
TypeCode_tk_TypeCode = 13;
TypeCode_tk_Principal = 14;
TypeCode_tk_objref = 15;
TypeCode_tk_struct = 16;
TypeCode_tk_union = 17;
TypeCode_tk_enum = 18;
TypeCode_tk_string = 19;
TypeCode_tk_sequence = 20;
TypeCode_tk_array = 21;
TypeCode_tk_pointer = 101; (* SOM extension *)
TypeCode_tk_self = 102; (* SOM extension *)
TypeCode_tk_foreign = 103; (* SOM extension *)
(* Short forms of tk_<x> enumerators *)
tk_null = TypeCode_tk_null;
tk_void = TypeCode_tk_void;
tk_short = TypeCode_tk_short;
tk_long = TypeCode_tk_long;
tk_ushort = TypeCode_tk_ushort;
tk_ulong = TypeCode_tk_ulong;
tk_float = TypeCode_tk_float;
tk_double = TypeCode_tk_double;
tk_boolean = TypeCode_tk_boolean;
tk_char = TypeCode_tk_char;
tk_octet = TypeCode_tk_octet;
tk_any = TypeCode_tk_any;
tk_TypeCode = TypeCode_tk_TypeCode;
tk_Principal = TypeCode_tk_Principal;
tk_objref = TypeCode_tk_objref;
tk_struct = TypeCode_tk_struct;
tk_union = TypeCode_tk_union;
tk_enum = TypeCode_tk_enum;
tk_string = TypeCode_tk_string;
tk_sequence = TypeCode_tk_sequence;
tk_array = TypeCode_tk_array;
tk_pointer = TypeCode_tk_pointer;
tk_self = TypeCode_tk_self;
tk_foreign = TypeCode_tk_foreign;
type
SOMClass_somOffsets = record
cls : SOMClassType;
offset : Longint;
end;
_IDL_SEQUENCE_SOMClass = record
_maximum : Cardinal;
_length : Cardinal;
_buffer : SOMClassPtr;
end;
_IDL_SEQUENCE_SOMObject = record
_maximum : Cardinal;
_length : Cardinal;
_buffer : PSOMObject;
end;
SOMClass_SOMClassSequence = _IDL_SEQUENCE_SOMClass;
(*----------------------------------------------------------------------
* Windows extra procedures:
*)
(*
* Replaceable character output handler.
* Points to the character output routine to be used in development
* support. Initialized to <somOutChar>, but may be reset at anytime.
* Should return 0 (false) if an error occurs and 1 (true) otherwise.
*)
type
somTD_SOMOutCharRoutine =Function(ch:Char):Longint; cdecl;
var
{$warning support of external vars required}
SOMOutCharRoutine :somTD_SOMOutCharRoutine;//³ 00015 ³ SOMOutCharRoutine
Procedure somSetOutChar(outch:somTD_SOMOutCharRoutine); cdecl;
external 'som' name 'somSetOutChar'; {index 85}
Function somMainProgram:SOMClassMgrType; cdecl;
external 'som' name 'somMainProgram'; {index 88}
Procedure somEnvironmentEnd; cdecl;
external 'som' name 'somEnvironmentEnd'; {index 83}
Function somAbnormalEnd:Boolean; cdecl;
external 'som' name 'somAbnormalEnd'; {index 84}
(*--------------------------------------------------------*)
(*---------------------------------------------------------------------
* Offset-based method resolution.
*)
Function somResolve(obj:TSOMObject; mdata:somMToken):{somMethodProc}pointer; cdecl;
external 'som' name 'somResolve'; {index 37}
Function somParentResolve(parentMtabs:somMethodTabs;
mToken:somMToken):somMethodProc; cdecl;
external 'som' name 'somParentResolve'; {index 33}
Function somParentNumResolve(parentMtabs:somMethodTabs;
parentNum:Longint;mToken:somMToken):{somMethodProc}pointer; cdecl;
external 'som' name 'somParentNumResolve'; {index 50}
Function somClassResolve(obj:SOMClassType; mdata:somMToken):{somMethodProc}pointer; cdecl;
external 'som' name 'somClassResolve'; {index 48}
Function somAncestorResolve(obj:TSOMObject; (* the object *)
var ccds:somCClassDataStructure; (* id the ancestor *)
mToken:somMToken):{somMethodProc}pointer; cdecl;
external 'som' name 'somAncestorResolve'; {index 74}
Function somResolveByName(obj:TSOMObject;
methodName:PChar):{somMethodProc}pointer; cdecl;
external 'som' name 'somResolveByName'; {index 61}
(*------------------------------------------------------------------------------
* Offset-based data resolution
*)
Function somDataResolve(obj:TSOMObject; dataId:somDToken):somToken; cdecl;
external 'som' name 'somDataResolve'; {index 47}
Function somDataResolveChk(obj:TSOMObject; dataId:somDToken):somToken; cdecl;
external 'som' name 'somDataResolveChk'; {index 72}
(*----------------------------------------------------------------------
* Misc. procedures:
*)
(*
* Create and initialize the SOM environment
*
* Can be called repeatedly
*
* Will be called automatically when first object (including a class
* object) is created, if it has not already been done.
*
* Returns the SOMClassMgrObject
*)
Function somEnvironmentNew:SOMClassMgrType; cdecl;
external 'som' name 'somEnvironmentNew'; {index 30}
(*
* Test whether <obj> is a valid SOM object. This test is based solely on
* the fact that (on this architecture) the first word of a SOM object is a
* pointer to its method table. The test is therefore most correctly understood
* as returning true if and only if <obj> is a pointer to a pointer to a
* valid SOM method table. If so, then methods can be invoked on <obj>.
*)
Function somIsObj(obj:somToken):Boolean; cdecl;
external 'som' name 'somIsObj'; {index 60}
(*
* Return the class that introduced the method represented by a given method token.
*)
Function somGetClassFromMToken(mToken:somMToken):SOMClassType; cdecl;
external 'som' name 'somGetClassFromMToken'; {index 82}
(*----------------------------------------------------------------------
* String Manager: stem <somsm>
*)
Function somCheckID(id:somId):somId; cdecl;
external 'som' name 'somCheckId'; {index 26}
(* makes sure that the id is registered and in normal form, returns *)
(* the id *)
Function somRegisterId(id:somId):Longint; cdecl;
external 'som' name 'somRegisterId'; {index 36}
(* Same as somCheckId except returns 1 (true) if this is the first *)
(* time the string associated with this id has been registered, *)
(* returns 0 (false) otherwise *)
Function somIDFromString(aString:PChar):somId; cdecl;
external 'som' name 'somIdFromString'; {index 31}
(* caller is responsible for freeing the returned id with SOMFree *)
// Not found
//Function somIdFromStringNoFree(aString:PChar):somId; cdecl;
(* call is responsible for *not* freeing the returned id *)
Function somStringFromId(id:somId):PChar; cdecl;
external 'som' name 'somStringFromId'; {index 40}
Function somCompareIds(id1,id2:somId):Longint; cdecl;
external 'som' name 'somCompareIds'; {index 27}
(* returns true (1) if the two ids are equal, else false (0) *)
Function somTotalRegIds:Longint; cdecl;
external 'som' name 'somTotalRegIds'; {index 43}
(* Returns the total number of ids that have been registered so far, *)
(* you can use this to advise the SOM runtime concerning expected *)
(* number of ids in later executions of your program, via a call to *)
(* somSetExpectedIds defined below *)
Procedure somSetExpectedIds(numIds:Longint{ulong}); cdecl;
external 'som' name 'somSetExpectedIds'; {index 39}
(* Tells the SOM runtime how many unique ids you expect to use during *)
(* the execution of your program, this can improve space and time *)
(* utilization slightly, this routine must be called before the SOM *)
(* environment is created to have any effect *)
Function somUniqueKey(id:somId):Longint{ulong}; cdecl;
external 'som' name 'somUniqueKey'; {index 44}
(* Returns the unique key for this id, this key will be the same as the *)
(* key in another id if and only if the other id refers to the same *)
(* name as this one *)
Procedure somBeginPersistentIds; cdecl;
external 'som' name 'somBeginPersistentIds'; {index 24}
(* Tells the id manager that strings for any new ids that are *)
(* registered will never be freed or otherwise modified. This allows *)
(* the id manager to just use a pointer to the string in the *)
(* unregistered id as the master copy of the ids string. Thus saving *)
(* space *)
(* Under normal use (where ids are static varibles) the string *)
(* associated with an id would only be freed if the code module in *)
(* which it occured was unloaded *)
Procedure somEndPersistentIds; cdecl;
external 'som' name 'somEndPersistentIds'; {index 29}
(* Tells the id manager that strings for any new ids that are *)
(* registered may be freed or otherwise modified. Therefore the id *)
(* manager must copy the strings inorder to remember the name of an *)
(* id. *)
(*----------------------------------------------------------------------
* Class Manager: SOMClassMgrType, stem <somcm>
*)
(* Global class manager object *)
var
{$warning support of external vars required}
SOMClassMgrObject : SOMClassMgrType;//³ 00007 ³ SOMClassMgrObject
(* The somRegisterClassLibrary function is provided for use
* in SOM class libraries on platforms that have loader-invoked
* entry points associated with shared libraries (DLLs).
*
* This function registers a SOM Class Library with the SOM Kernel.
* The library is identified by its file name and a pointer
* to its initialization routine. Since this call may occur
* prior to the invocation of somEnvironmentNew, its actions
* are deferred until the SOM environment has been initialized.
* At that time, the SOMClassMgrObject is informed of all
* pending library initializations via the _somRegisterClassLibrary
* method. The actual invocation of the library's initialization
* routine will occur during the execution of the SOM_MainProgram
* macro (for statically linked libraries), or during the _somFindClass
* method (for libraries that are dynamically loaded).
*)
Procedure somRegisterClassLibrary(libraryName:PChar;
libraryInitRun:somMethodProc); cdecl;
external 'som' name 'somRegisterClassLibrary'; {index 86}
(*----------------------------------------------------------------------
* -- somApply --
*
* This routine replaces direct use of applyStubs in SOMr1. The reason
* for the replacement is that the SOMr1 style of applyStub is not
* generally available in SOMr2, which uses a fixed set of applyStubs,
* according to method information in the somMethodData. In particular,
* neither the redispatch stub nor the apply stub found in the method
* data structure are necessarily useful as such. The method somGetRdStub
* is the way to get a redispatch stub, and the above function is the
* way to call an apply stub. If an appropriate apply stub for the
* method indicated by md is available, then this is invoked and TRUE is
* returned; otherwise FALSE is returned.
*
* The va_list passed to somApply *must* include the target object,
* somSelf, as its first entry, and any single precision floating point
* arguments being passed to the the method procedure must be
* represented on the va_list using double precision values. retVal cannot
* be NULL.
*)
Function somApply(var somSelf:TSOMObject;
var retVal:somToken;
mdPtr:somMethodDataPtr;
var ap):Boolean; cdecl;
external 'som' name 'somApply'; {index 69}
(*---------------------------------------------------------------------
* -- somBuildClass --
*
* This procedure automates construction of a new class object. A variety of
* special structures are used to allow language bindings to statically define
* the information necessary to specify a class. Pointers to these static
* structures are accumulated into an overall "static class information"
* structure or SCI, passed to somBuildClass. The SCI has evolved over time.
* The current version is defined here.
*)
Function somBuildClass(inherit_vars:Longint;
var sci:somStaticClassInfo;
majorVersion,minorVersion:Longint):SOMClassType; cdecl;
external 'som' name 'somBuildClass'; {index 49}
(*
The arguments to somBuildClass are as follows:
inherit_vars: a bit mask used to control inheritance of implementation
Implementation is inherited from parent i iff the bit 1<<i is on, or i>=32.
sci: the somStaticClassInfo defined above.
majorVersion, minorVersion: the version of the class implementation.
*)
(*---------------------------------------------------------------------
* Used by old single-inheritance emitters to make class creation
* an atomic operation. Kept for backwards compatability.
*)
type
somTD_classInitRoutine=Procedure(var a,b:SOMClassType); cdecl;
Procedure somConstructClass(classInitRoutine:somTD_ClassInitRoutine;
parentClass,metaClass:SOMClassType;
var cds :somClassDataStructure); cdecl;
external 'som' name 'somConstructClass'; {index 28}
(*
* Uses <SOMOutCharRoutine> to output its arguments under control of the ANSI C
* style format. Returns the number of characters output.
*)
Function somPrintf(fnt:PChar;buf:pointer):Longint; cdecl;
external 'som' name 'somPrintf'; {index 35}
// vprint form of somPrintf
Function somVPrintf(fnt:PChar;var ap):Longint; cdecl;
external 'som' name 'somVprintf'; {index 45}
// Outputs (via somPrintf) blanks to prefix a line at the indicated level
Procedure somPrefixLevel(level:Longint); cdecl;
external 'som' name 'somPrefixLevel'; {index 34}
// Combines somPrefixLevel and somPrintf
Procedure somLPrintf(level:Longint;fmt:PChar;var buf); cdecl;
external 'som' name 'somLPrintf'; {index 32}
Function SOMObjectNewClass(majorVersion,minorVersion:Longint):SOMClassType; cdecl;
external 'som' name 'SOMObjectNewClass'; {index 22}
Function SOMClassNewClass(majorVersion,minorVersion:Longint):SOMClassType; cdecl;
external 'som' name 'SOMClassNewClass'; {index 21}
Function SOMClassMgrNewClass(majorVersion,minorVersion:Longint):SOMClassType; cdecl;
external 'som' name 'SOMClassMgrNewClass'; {index 20}
(*----------------------------------------------------------------------
* Pointers to routines used to do dynamic code loading and deleting
*)
type
somTD_SOMLoadModule =Function({IN}Module:PChar (* className *);
{IN}FileName:PChar (* fileName *);
{IN}FuncName:PChar (* functionName *);
{IN}MajorVer:Longint (* majorVersion *);
{IN}MinorVer:Longint (* minorVersion *);
{OUT}var ref:somToken (* modHandle *)):Longint; cdecl;
somTD_SOMDeleteModule =Function({IN} ref:somToken (* modHandle *)):Longint; cdecl;
somTD_SOMClassInitFuncName =Function:PChar; cdecl;
var
{$warning support of external vars required}
SOMLoadModule :somTD_SOMLoadModule;//³ 00011 ³ SOMLoadModule
{$warning support of external vars required}
SOMDeleteModule :somTD_SOMDeleteModule;//³ 00008 ³ SOMDeleteModule
{$warning support of external vars required}
SOMClassInitFuncName :somTD_SOMClassInitFuncName; //³ 00004 ³ SOMClassInitFuncName
(*----------------------------------------------------------------------
* Replaceable SOM Memory Management Interface
*
* External procedure variables SOMCalloc, SOMFree, SOMMalloc, SOMRealloc
* have the same interface as their standard C-library analogs.
*)
type
somTD_SOMMalloc =Function({IN} size_t:Longint (* nbytes *)):somToken; cdecl;
somTD_SOMCalloc =Function({IN} size_c:Longint (* element_count *);
{IN} size_e:Longint (* element_size *)):somToken; cdecl;
somTD_SOMRealloc =Function({IN} ref:somToken (* memory *);
{IN} size:Longint (* nbytes *)):somToken; cdecl;
somTD_SOMFree =Procedure({IN} ref:somToken (* memory *)); cdecl;
var
{$warning support of external vars required}
SOMCalloc :somTD_SOMCalloc; // ³ 00001 ³ SOMCalloc
{$warning support of external vars required}
SOMFree :somTD_SOMFree; //³ 00010 ³ SOMFree
{$warning support of external vars required}
SOMMalloc :somTD_SOMMalloc;//³ 00012 ³ SOMMalloc
{$warning support of external vars required}
SOMRealloc :somTD_SOMRealloc;//³ 00016 ³ SOMRealloc
(*----------------------------------------------------------------------
* Replaceable SOM Error handler
*)
type
somTD_SOMError =Procedure({IN} code:Longint (* code *);
{IN} fn:PChar (* fileName *);
{IN} ln:Longint (* linenum *)); cdecl;
var
{$warning support of external vars required}
SOMError :somTD_SOMError;//³ 00009 ³ SOMError
(*----------------------------------------------------------------------
* Replaceable SOM Semaphore Operations
*
* These operations are used by the SOM Kernel to make thread-safe
* state changes to internal resources.
*)
type
somTD_SOMCreateMutexSem =Function({OUT}var sem:somToken ):Longint; cdecl;
somTD_SOMRequestMutexSem =Function({IN}sem:somToken ):Longint; cdecl;
somTD_SOMReleaseMutexSem =Function({IN}sem:somToken ):Longint; cdecl;
somTD_SOMDestroyMutexSem =Function({IN}sem:somToken ):Longint; cdecl;
var
{$warning support of external vars required}
SOMCreateMutexSem :somTD_SOMCreateMutexSem;//³ 00090 ³ SOMCreateMutexSem
{$warning support of external vars required}
SOMRequestMutexSem :somTD_SOMRequestMutexSem;//³ 00091 ³ SOMRequestMutexSem
{$warning support of external vars required}
SOMReleaseMutexSem :somTD_SOMReleaseMutexSem;//³ 00092 ³ SOMReleaseMutexSem
{$warning support of external vars required}
SOMDestroyMutexSem :somTD_SOMDestroyMutexSem;//³ 00093 ³ SOMDestroyMutexSem
(*----------------------------------------------------------------------
* Replaceable SOM Thread Identifier Operation
*
* This operation is used by the SOM Kernel to index data unique to the
* currently executing thread. It must return a small integer that
* uniquely represents the current thread within the current process.
*)
type
somTD_SOMGetThreadId =Function:Longint; cdecl;
var
{$warning support of external vars required}
SOMGetThreadId :somTD_SOMGetThreadId;//³ 00094 ³ SOMGetThreadId
(*----------------------------------------------------------------------
* Externals used in the implementation of SOM, but not part of the
* SOM API.
*)
Function somTestCls(obj:TSOMObject; classObj:SOMClassType;
fileName:PChar; lineNumber:Longint):TSOMObject; cdecl;
external 'som' name 'somTestCls'; {index 42}
Procedure somTest(condition,severity:Longint;fileName:PChar;
lineNum:Longint;msg:PChar); cdecl;
external 'som' name 'somTest'; {index 41}
Procedure somAssert(condition,ecode:Longint;
fileName:PChar;lineNum:Longint;msg:PChar); cdecl;
external 'som' name 'somAssert'; {index 23}
type
exception_type = (NO_EXCEPTION, USER_EXCEPTION, SYSTEM_EXCEPTION);
completion_status = (YES, NO, MAYBE);
StExcep = record
minot : Cardinal;
completed : completion_status;
end;
Environment =^EnvironmentType;
EnvironmentType = record
_major : exception_type;
exception : record
_exception_name : PChar;
_params : Pointer;
end;
_somdAnchor : pointer;
end;
Function somExceptionId(ev:Environment):PChar; cdecl;
external 'som' name 'somExceptionId'; {index 52}
Function somExceptionValue(ev:Environment):Pointer; cdecl;
external 'som' name 'somExceptionValue'; {index 53}
Procedure somExceptionFree(ev:Environment); cdecl;
external 'som' name 'somExceptionFree'; {index 54}
Procedure somSetException(ev:Environment;major:exception_type;exception_name:PChar;params:pointer); cdecl;
external 'som' name 'somSetException'; {index 55}
Function somGetGlobalEnvironment:Environment; cdecl;
external 'som' name 'somGetGlobalEnvironment'; {index 58}
(* Exception function names per CORBA 5.19, p.99 *)
Function exception_id(ev:Environment):PChar; cdecl;
Function exception_value(ev:Environment):Pointer; cdecl;
Procedure exception_free(ev:Environment); cdecl;
(* Convenience macros for manipulating environment structures
*
* SOM_CreateLocalEnvironment returns a pointer to an Environment.
* The other 3 macros all expect a single argument that is also
* a pointer to an Environment. Use the create/destroy forms for
* a dynamic local environment and the init/uninit forms for a stack-based
* local environment.
*
* For example
*
* Environment *ev;
* ev = SOM_CreateLocalEnvironment ();
* ... Use ev in methods
* SOM_DestroyLocalEnvironment (ev);
*
* or
*
* Environment ev;
* SOM_InitEnvironment (&ev);
* ... Use &ev in methods
* SOM_UninitEnvironment (&ev);
*)
Function SOM_CreateLocalEnvironment:Environment; cdecl;
Procedure SOM_DestroyLocalEnvironment(ev:Environment); cdecl;
Procedure SOM_InitEnvironment(ev:Environment); cdecl;
Procedure SOM_UninitEnvironment(ev:Environment); cdecl;
(*----------------------------------------------------------------------
* Macros are used in the C implementation of SOM... However, Pascal
* doesn't have macro capability... (from SOMCDEV.H)
*)
{ Change SOM_Resolve(o,ocn,mn) to...
somTD_ocn_mn(somResolve(SOM_TestCls(o, ocnClassData.classObject), ocnClassData.mn)))
Change SOM_ResolveNoCheck(o,ocn,mn) to...
somTD_ocn_mn(somResolve(o,ocnClassData,mn))
Change SOM_ParentNumResolveCC(pcn,pcp,ocn,mn) to...
somTD_pcn_mn(somParentNumResolve(ocn_CClassData.parentMtab,pcp,pcnClassData.mn))
Change SOM_ParentNumResolve(pcn,pcp,mtabs,mn) to...
somTD_pcn_mn(somParentNumResolve(mtabs,pcp,pcnClassData.mn))
Change SOM_ClassResolve(cn,class,mn) to...
somTD_cn_mn(somClassResolve(class,cnClassData.mn))
Change SOM_ResolveD(o,tdc,cdc,mn) to...
somTD_tdc_mn(somResolve(SOM_TestCls(o,cdcClassData.classObject), cdcClassData.mn)))
Change SOM_ParentResolveE(pcn,mtbls,mn) to...
somTD_pcn_mn(somParentResolve(mtbls,pcnClassData.mn))
Change SOM_DataResolve(obj,dataId) to...
somDataResolve(obj, dataId)
Change SOM_ClassLibrary(name) to...
somRegisterClassLibrary(name,somMethodProc(SOMInitModule))
}
type
SOMClassCClassDataStructure = record
parentMtab : somMethodTabs;
instanceDataToken : somDToken;
end;
var
{$warning support of external vars required}
SOMClassCClassData : SOMClassCClassDataStructure;//³ 00002 ³ SOMClassCClassData
type
SOMClassClassDataStructure = record
classObject : SOMClassType;
somNew : somMToken;
somRenew : somMToken;
somInitClass : somMToken;
somClassReady : somMToken;
somGetName : somMToken;
somGetParent : somMToken;
somDescendedFrom : somMToken;
somCheckVersion : somMToken;
somFindMethod : somMToken;
somFindMethodOk : somMToken;
somSupportsMethod : somMToken;
somGetNumMethods : somMToken;
somGetInstanceSize : somMToken;
somGetInstanceOffset : somMToken;
somGetInstancePartSize : somMToken;
somGetMethodIndex : somMToken;
somGetNumStaticMethods : somMToken;
somGetPClsMtab : somMToken;
somGetClassMtab : somMToken;
somAddStaticMethod : somMToken;
somOverrideSMethod : somMToken;
somAddDynamicMethod : somMToken;
somcPrivate0 : somMToken;
somGetApplyStub : somMToken;
somFindSMethod : somMToken;
somFindSMethodOk : somMToken;
somGetMethodDescriptor : somMToken;
somGetNthMethodInfo : somMToken;
somSetClassData : somMToken;
somGetClassData : somMToken;
somNewNoInit : somMToken;
somRenewNoInit : somMToken;
somGetInstanceToken : somMToken;
somGetMemberToken : somMToken;
somSetMethodDescriptor : somMToken;
somGetMethodData : somMToken;
somOverrideMtab : somMToken;
somGetMethodToken : somMToken;
somGetParents : somMToken;
somGetPClsMtabs : somMToken;
somInitMIClass : somMToken;
somGetVersionNumbers : somMToken;
somLookupMethod : somMToken;
_get_somInstanceDataOffsets : somMToken;
somRenewNoZero : somMToken;
somRenewNoInitNoZero : somMToken;
somAllocate : somMToken;
somDeallocate : somMToken;
somGetRdStub : somMToken;
somGetNthMethodData : somMToken;
somcPrivate1 : somMToken;
somcPrivate2 : somMToken;
_get_somDirectInitClasses : somMToken;
_set_somDirectInitClasses : somMToken;
somGetInstanceInitMask : somMToken;
somGetInstanceDestructionMask : somMToken;
somcPrivate3 : somMToken;
somcPrivate4 : somMToken;
somcPrivate5 : somMToken;
somcPrivate6 : somMToken;
somcPrivate7 : somMToken;
somDefinedMethod : somMToken;
somcPrivate8 : somMToken;
somcPrivate9 : somMToken;
somcPrivate10 : somMToken;
somcPrivate11 : somMToken;
somcPrivate12 : somMToken;
somcPrivate13 : somMToken;
somcPrivate14 : somMToken;
somcPrivate15 : somMToken;
_get_somDataAlignment : somMToken;
somGetInstanceAssignmentMask : somMToken;
somcPrivate16 : somMToken;
somcPrivate17 : somMToken;
_get_somClassAllocate : somMToken;
_get_somClassDeallocate : somMToken;
end;
var
{$warning support of external vars required}
SOMClassClassData : SOMClassClassDataStructure;//³ 00003 ³ SOMClassClassData
{$warning support of external vars required}
SOMClassMgrCClassData : somCClassDataStructure;//³ 00005 ³ SOMClassMgrCClassData
type
SOMClassMgrClassDataStructure = record
classObject : SOMClassType;
somFindClsInFile : somMToken;
somFindClass : somMToken;
somClassFromId : somMToken;
somRegisterClass : somMToken;
somUnregisterClass : somMToken;
somLocateClassFile : somMToken;
somLoadClassFile : somMToken;
somUnloadClassFile : somMToken;
somGetInitFunction : somMToken;
somMergeInto : somMToken;
somGetRelatedClasses : somMToken;
somSubstituteClass : somMToken;
_get_somInterfaceRepository : somMToken;
_set_somInterfaceRepository : somMToken;
_get_somRegisteredClasses : somMToken;
somBeginPersistentClasses : somMToken;
somEndPersistentClasses : somMToken;
somcmPrivate1 : somMToken;
somcmPrivate2 : somMToken;
somRegisterClassLibrary : somMToken;
somJoinAffinityGroup : somMToken;
end;
var
{$warning support of external vars required}
SOMClassMgrClassData : SOMClassMgrClassDataStructure;//³ 00006 ³ SOMClassMgrClassData
type
SOMObjectCClassDataStructure = record
parentMtab :somMethodTabs;
instanceDataToken :somDToken;
end;
var
{$warning support of external vars required}
SOMObjectCClassData : SOMObjectCClassDataStructure;//³ 00013 ³ SOMObjectCClassData
type
SOMObjectClassDataStructure = record
classObject : SOMClassType;
somInit : somMToken;
somUninit : somMToken;
somFree : somMToken;
somDefaultVCopyInit : somMToken;
somGetClassName : somMToken;
somGetClass : somMToken;
somIsA : somMToken;
somRespondsTo : somMToken;
somIsInstanceOf : somMToken;
somGetSize : somMToken;
somDumpSelf : somMToken;
somDumpSelfInt : somMToken;
somPrintSelf : somMToken;
somDefaultConstVCopyInit : somMToken;
somDispatchV : somMToken;
somDispatchL : somMToken;
somDispatchA : somMToken;
somDispatchD : somMToken;
somDispatch : somMToken;
somClassDispatch : somMToken;
somCastObj : somMToken;
somResetObj : somMToken;
somDefaultInit : somMToken;
somDestruct : somMToken;
somPrivate1 : somMToken;
somPrivate2 : somMToken;
somDefaultCopyInit : somMToken;
somDefaultConstCopyInit : somMToken;
somDefaultAssign : somMToken;
somDefaultConstAssign : somMToken;
somDefaultVAssign : somMToken;
somDefaultConstVAssign : somMToken;
end;
var
{$warning support of external vars required}
SOMObjectClassData : SOMObjectClassDataStructure;//³ 00014 ³ SOMObjectClassData
(* Another not ported vars *)
// Control the printing of method and procedure entry messages,
// 0-none, 1-user, 2-core&user */
SOM_TraceLevel: Longint; //³ 00018 ³ SOM_TraceLevel
// Control the printing of warning messages, 0-none, 1-all
SOM_WarnLevel: Longint; //³ 00019 ³ SOM_WarnLevel
// Control the printing of successful assertions, 0-none, 1-user,
// 2-core&user
SOM_AssertLevel: Longint; //³ 00017 ³ SOM_AssertLevel
// ToDo: Move this to corresponding place
Procedure somCheckArgs(argc: longint; argv: array of pchar); cdecl;
external 'som' name 'somCheckArgs'; {index 25}
Procedure somUnregisterClassLibrary (libraryName: PChar); cdecl;
external 'som' name 'somUnregisterClassLibrary'; {index 89}
Function somResolveTerminal(x : SOMClassPtr; mdata: somMToken): somMethodProcPtr; cdecl;
external 'som' name 'somResolveTerminal'; {index 133}
Function somPCallResolve(obj: PSOMObject; callingCls: SOMClassPtr; method: somMToken): somMethodProcPtr; cdecl;
external 'som' name 'somPCallResolve'; {index 362}
Function va_SOMObject_somDispatchA(somSelf: PSOMObject;
methodId: somId;
descriptor: somId;
args: array of const): Pointer; cdecl;
external 'som' name 'va_SOMObject_somDispatchA'; {index 64}
Function somva_SOMObject_somDispatchA(somSelf: PSOMObject;
methodId: somId;
descriptor: somId;
args: array of const): Pointer; cdecl;
external 'som' name 'somva_SOMObject_somDispatchA'; {index 96}
Function va_SOMObject_somDispatchL(somSelf: PSOMObject;
methodId: somId;
descriptor: somId;
args: array of const): Longint; cdecl;
external 'som' name 'va_SOMObject_somDispatchL'; {index 66}
Function somva_SOMObject_somDispatchL(somSelf: PSOMObject;
methodId: somId;
descriptor: somId;
args: array of const): Longint; cdecl;
external 'som' name 'somva_SOMObject_somDispatchL'; {index 98}
Function va_SOMObject_somDispatch(somSelf: PSOMObject;
retValue: PsomToken;
methodId: somId;
args: array of const): Boolean; cdecl;
external 'som' name 'va_SOMObject_somDispatch'; {index 68}
Procedure va_SOMObject_somDispatchV(somSelf: PSOMObject;
methodId: somId;
descriptor: somId;
args: array of const); cdecl;
external 'som' name 'va_SOMObject_somDispatchV'; {index 67}
Procedure somva_SOMObject_somDispatchV(somSelf: PSOMObject;
methodId: somId;
descriptor: somId;
args: array of const); cdecl;
external 'som' name 'somva_SOMObject_somDispatchV'; {index 99}
Function va_SOMObject_somDispatchD(somSelf: PSOMObject;
methodId: somId;
descriptor: somId;
args: array of const): double; cdecl;
external 'som' name 'va_SOMObject_somDispatchD'; {index 65}
Function somva_SOMObject_somDispatchD(somSelf: PSOMObject;
methodId: somId;
descriptor: somId;
args: array of const): double; cdecl;
external 'som' name 'somva_SOMObject_somDispatchD'; {index 97}
Function somva_SOMObject_somDispatch(somSelf: PSOMObject;
retValue: PsomToken;
methodId: somId;
args: array of const): boolean; cdecl;
external 'som' name 'somva_SOMObject_somDispatch'; {index 100}
Function somva_SOMObject_somClassDispatch(somSelf: PSOMObject;
clsObj: PSOMClass;
retValue: PsomToken;
methodId: somId;
args: array of const): boolean; cdecl;
external 'som' name 'somva_SOMObject_somClassDispatch'; {index 101}
Implementation
Function exception_id(ev:Environment):PChar; cdecl;
begin
Result := somExceptionId(ev)
end;
Function exception_value(ev:Environment):Pointer; cdecl;
begin
Result := somExceptionValue(ev)
end;
Procedure exception_free(ev:Environment); cdecl;
begin
somExceptionFree(ev)
end;
Function SOM_CreateLocalEnvironment:Environment; cdecl;
begin
Result:=SOMCalloc(1, sizeof(EnvironmentType))
end;
Procedure SOM_DestroyLocalEnvironment(ev:Environment); cdecl;
begin
somExceptionFree(ev);
if somGetGlobalEnvironment<>ev then SOMFree(ev);
end;
Procedure SOM_InitEnvironment(ev:Environment); cdecl;
begin
if somGetGlobalEnvironment<>ev then FillChar(ev^,sizeof(EnvironmentType),0);
end;
Procedure SOM_UninitEnvironment(ev:Environment); cdecl;
begin
somExceptionFree(ev);
end;
End.
(*
³ 00038 ³ somSaveMetrics // not found
³ 00046 ³ somWriteMetrics // not found
³ 00051 ³ somCreateDynamicClass // not found
³ 00056 ³ SOM_IdTable // not found
³ 00057 ³ SOM_IdTableSize // not found
³ 00062 ³ somStartCriticalSection // not found
³ 00063 ³ somEndCriticalSection // not found
³ 00080 ³ somfixMsgTemplate // not found
³ 00087 ³ SOMParentDerivedMetaclassClassData // not found
³ 00132 ³ somFreeThreadData // not found
³ 00135 ³ somIdMarshal // not found
³ 00361 ³ somMakeUserRdStub // Not found
*)
{
$Log$
Revision 1.5 2004-12-23 05:16:31 yuri
* Fixed compilation
Revision 1.4 2004/12/23 05:04:38 yuri
* Porting finished.
Revision 1.3 2004/05/26 16:38:58 yuri
* Some functions updated.
Revision 1.2 2003/11/30 08:13:14 yuri
* more ported functions
Revision 1.1 2003/09/22 13:52:59 yuri
+ Initial import. Mostly backup.
}
Reference in New Issue View Git Blame Copy Permalink