OSDN -- Open-Source-Software-Entwicklung und Downloads
Übersetzungsstatus von Deutsch translation status for de
  • R/O
  • SSH
Fork

SOM-Delphi: Commit

Delphi 7 bindings generator for IBM System Object Model 2.1


Commit MetaInfo

Revisionbfeeb6eebca5504427713fcc788bb61ec25af545 (tree)
Zeit2016-10-30 05:08:16
AutorIvan Levashev <bo_ <gen@octa...>
CommiterIvan Levashev <bo_

Log Message

Hiding or reintroducing methods from TObject in hardwired SOMObjectBase and
TypeCode, but not in generated classes yet

Ändern Zusammenfassung

Diff

diff -r c34e53e000f0 -r bfeeb6eebca5 SOMIRIMP.SOM.pas
--- a/SOMIRIMP.SOM.pas Sun Oct 30 00:46:17 2016 +0700
+++ b/SOMIRIMP.SOM.pas Sun Oct 30 03:08:16 2016 +0700
@@ -784,17 +784,79 @@
784784
785785 { Classes }
786786 SOMObjectBase = class
787- private
788- { hide TObject methods }
789- procedure Create; reintroduce;
787+ { hide or reimplement TObject methods }
788+ protected
789+ class procedure Create; reintroduce;
790+ public
791+ procedure Free; reintroduce;
792+ protected
793+ class procedure InitInstance; reintroduce;
794+ public
795+ procedure CleanupInstance; reintroduce;
796+ function ClassType: SOMClass; reintroduce;
797+ protected
798+ class procedure ClassName; reintroduce;
799+ class procedure ClassNameIs; reintroduce;
800+ class procedure ClassParent; reintroduce;
801+ class procedure ClassInfo; reintroduce;
802+ class procedure InstanceSize; reintroduce;
803+ class procedure InheritsFrom; reintroduce;
804+ class procedure MethodAddress; reintroduce;
805+ class procedure MethodName; reintroduce;
806+ procedure FieldAddress; reintroduce;
807+ procedure GetInterface; reintroduce;
808+ class procedure GetInterfaceEntry; reintroduce;
809+ class procedure GetInterfaceTable; reintroduce;
810+ procedure SafeCallException; reintroduce;
811+ public
812+ procedure AfterConstruction; reintroduce;
813+ procedure BeforeDestruction; reintroduce;
814+ protected
815+ procedure Dispatch; reintroduce;
816+ procedure DefaultHandler; reintroduce;
817+ class procedure NewInstance; reintroduce;
818+ public
819+ procedure FreeInstance; reintroduce;
790820 procedure Destroy; reintroduce;
791- public
821+
822+ { Upcasting }
792823 function As_SOMObject: SOMObject; {$IFDEF DELPHI_HAS_INLINE} inline; {$ENDIF}
793824 end;
794825
795826 TypeCode = class
796- private
797- { hide TObject methods }
827+ { hide or reimplement TObject methods }
828+ public
829+ procedure Free; reintroduce;
830+ protected
831+ class procedure InitInstance; reintroduce;
832+ public
833+ procedure CleanupInstance; reintroduce;
834+ protected
835+ procedure ClassType; reintroduce;
836+ public
837+ class function ClassName: string; reintroduce;
838+ class function ClassNameIs(const Name: string): Boolean; reintroduce;
839+ protected
840+ class procedure ClassParent; reintroduce;
841+ class procedure ClassInfo; reintroduce;
842+ class procedure InstanceSize; reintroduce;
843+ class procedure InheritsFrom; reintroduce;
844+ class procedure MethodAddress; reintroduce;
845+ class procedure MethodName; reintroduce;
846+ procedure FieldAddress; reintroduce;
847+ procedure GetInterface; reintroduce;
848+ class procedure GetInterfaceEntry; reintroduce;
849+ class procedure GetInterfaceTable; reintroduce;
850+ procedure SafeCallException; reintroduce;
851+ public
852+ procedure AfterConstruction; reintroduce;
853+ procedure BeforeDestruction; reintroduce;
854+ protected
855+ procedure Dispatch; reintroduce;
856+ procedure DefaultHandler; reintroduce;
857+ class procedure NewInstance; reintroduce;
858+ public
859+ procedure FreeInstance; reintroduce;
798860 procedure Destroy; reintroduce;
799861 protected
800862 function GetKind: TCKind;
@@ -834,7 +896,6 @@
834896 class function TC_FullInterfaceDescription: TypeCode;
835897 function Equal(y: TypeCode): CORBABoolean;
836898 function Copy: TypeCode;
837- procedure Free;
838899 procedure Print;
839900 class function Create(tag: TCKind): TypeCode; overload;
840901 class function Create(tag: TCKind; const Arguments: array of const): TypeCode; overload;
@@ -5897,14 +5958,129 @@
58975958 var
58985959 DLLLoad_CriticalSection : Windows.TRTLCriticalSection;
58995960
5900-procedure SOMObjectBase.Create;
5961+class procedure SOMObjectBase.Create;
59015962 begin
59025963 { hide this method }
59035964 end;
59045965
5966+procedure SOMObjectBase.Free;
5967+begin
5968+ if Assigned(Self) then SOMObject(Self).somFree;
5969+end;
5970+
5971+class procedure SOMObjectBase.InitInstance;
5972+begin
5973+ { hide this method }
5974+end;
5975+
5976+procedure SOMObjectBase.CleanupInstance;
5977+begin
5978+ { in SOM, everything is being cleaned up by destructors }
5979+end;
5980+
5981+function SOMObjectBase.ClassType: SOMClass;
5982+begin
5983+ Result := SOMObject(Self).somGetClass;
5984+end;
5985+
5986+class procedure SOMObjectBase.ClassName;
5987+begin
5988+ { hide this method }
5989+end;
5990+
5991+class procedure SOMObjectBase.ClassNameIs;
5992+begin
5993+ { hide this method }
5994+end;
5995+
5996+class procedure SOMObjectBase.ClassParent;
5997+begin
5998+ { hide this method }
5999+end;
6000+
6001+class procedure SOMObjectBase.ClassInfo;
6002+begin
6003+ { hide this method }
6004+end;
6005+
6006+class procedure SOMObjectBase.InstanceSize;
6007+begin
6008+ { hide this method }
6009+end;
6010+
6011+class procedure SOMObjectBase.InheritsFrom;
6012+begin
6013+ { hide this method }
6014+end;
6015+
6016+class procedure SOMObjectBase.MethodAddress;
6017+begin
6018+ { hide this method }
6019+end;
6020+
6021+class procedure SOMObjectBase.MethodName;
6022+begin
6023+ { hide this method }
6024+end;
6025+
6026+procedure SOMObjectBase.FieldAddress;
6027+begin
6028+ { hide this method }
6029+end;
6030+
6031+procedure SOMObjectBase.GetInterface;
6032+begin
6033+ { hide this method }
6034+end;
6035+
6036+class procedure SOMObjectBase.GetInterfaceEntry;
6037+begin
6038+ { hide this method }
6039+end;
6040+
6041+class procedure SOMObjectBase.GetInterfaceTable;
6042+begin
6043+ { hide this method }
6044+end;
6045+
6046+procedure SOMObjectBase.SafeCallException;
6047+begin
6048+ { hide this method }
6049+end;
6050+
6051+procedure SOMObjectBase.AfterConstruction;
6052+begin
6053+ { in SOM that is being done by cooperative metaclass }
6054+end;
6055+
6056+procedure SOMObjectBase.BeforeDestruction;
6057+begin
6058+ { in SOM that is being done by cooperative metaclass }
6059+end;
6060+
6061+procedure SOMObjectBase.Dispatch;
6062+begin
6063+ { hide this method }
6064+end;
6065+
6066+procedure SOMObjectBase.DefaultHandler;
6067+begin
6068+ { hide this method }
6069+end;
6070+
6071+class procedure SOMObjectBase.NewInstance;
6072+begin
6073+ { hide this method }
6074+end;
6075+
6076+procedure SOMObjectBase.FreeInstance;
6077+begin
6078+ SOMObject(Self).somGetClass.somDeallocate(PAnsiChar(Pointer(Self)));
6079+end;
6080+
59056081 procedure SOMObjectBase.Destroy;
59066082 begin
5907- { hide this method }
6083+ SOMObject(Self).somFree;
59086084 end;
59096085
59106086 function SOMObjectBase.As_SOMObject; {$IFDEF DELPHI_HAS_INLINE} inline; {$ENDIF}
@@ -5931,11 +6107,135 @@
59316107 Pointer(V_Pointer) := Windows.GetProcAddress(SOMTC_DLL, PAnsiChar(Var_Name));
59326108 end;
59336109
5934-procedure TypeCode.Destroy;
6110+procedure TypeCode.Free;
6111+begin
6112+ if Assigned(Self) then
6113+ begin
6114+ FreeInstance;
6115+ end;
6116+end;
6117+
6118+class procedure TypeCode.InitInstance;
59356119 begin
59366120 { hide this method }
59376121 end;
59386122
6123+procedure TypeCode.CleanupInstance;
6124+begin
6125+ { TypeCode_free does everything at the same time, so no separate Cleanup }
6126+end;
6127+
6128+procedure TypeCode.ClassType;
6129+begin
6130+ { hide this method }
6131+end;
6132+
6133+class function TypeCode.ClassName: string;
6134+begin
6135+ Result := 'TypeCode';
6136+end;
6137+
6138+class function TypeCode.ClassNameIs(const Name: string): Boolean;
6139+begin
6140+ Result := Name = 'TypeCode';
6141+end;
6142+
6143+class procedure TypeCode.ClassParent;
6144+begin
6145+ { hide this method }
6146+end;
6147+
6148+class procedure TypeCode.ClassInfo;
6149+begin
6150+ { hide this method }
6151+end;
6152+
6153+class procedure TypeCode.InstanceSize;
6154+begin
6155+ { hide this method }
6156+end;
6157+
6158+class procedure TypeCode.InheritsFrom;
6159+begin
6160+ { hide this method }
6161+end;
6162+
6163+class procedure TypeCode.MethodAddress;
6164+begin
6165+ { hide this method }
6166+end;
6167+
6168+class procedure TypeCode.MethodName;
6169+begin
6170+ { hide this method }
6171+end;
6172+
6173+procedure TypeCode.FieldAddress;
6174+begin
6175+ { hide this method }
6176+end;
6177+
6178+procedure TypeCode.GetInterface;
6179+begin
6180+ { hide this method }
6181+end;
6182+
6183+class procedure TypeCode.GetInterfaceEntry;
6184+begin
6185+ { hide this method }
6186+end;
6187+
6188+class procedure TypeCode.GetInterfaceTable;
6189+begin
6190+ { hide this method }
6191+end;
6192+
6193+procedure TypeCode.SafeCallException;
6194+begin
6195+ { hide this method }
6196+end;
6197+
6198+procedure TypeCode.AfterConstruction;
6199+begin
6200+ { nothing to do }
6201+end;
6202+
6203+procedure TypeCode.BeforeDestruction;
6204+begin
6205+ { nothing to do }
6206+end;
6207+
6208+procedure TypeCode.Dispatch;
6209+begin
6210+ { hide this method }
6211+end;
6212+
6213+procedure TypeCode.DefaultHandler;
6214+begin
6215+ { hide this method }
6216+end;
6217+
6218+class procedure TypeCode.NewInstance;
6219+begin
6220+ { hide this method }
6221+end;
6222+
6223+procedure TypeCode_free(t: TypeCode; ev: PEnvironment); stdcall; external SOMTC_DLL_Name name 'tcFree';
6224+
6225+procedure TypeCode.FreeInstance;
6226+var
6227+ LocalEnv: Environment;
6228+begin
6229+ SOM_InitEnvironment(@LocalEnv);
6230+ TypeCode_free(Self, @LocalEnv);
6231+ SOM_UninitEnvironmentOrRaise(@LocalEnv);
6232+end;
6233+
6234+procedure TypeCode.Destroy;
6235+begin
6236+ FreeInstance;
6237+end;
6238+
59396239 function TypeCode_kind(t: TypeCode; ev: PEnvironment): TCKind; stdcall; external SOMTC_DLL_Name name 'tcKind';
59406240
59416241 function TypeCode.GetKind: TCKind;
@@ -6416,17 +6716,6 @@
64166716 SOM_UninitEnvironmentOrRaise(@LocalEnv);
64176717 end;
64186718
6419-procedure TypeCode_free(t: TypeCode; ev: PEnvironment); stdcall; external SOMTC_DLL_Name name 'tcFree';
6420-
6421-procedure TypeCode.Free;
6422-var
6423- LocalEnv: Environment;
6424-begin
6425- SOM_InitEnvironment(@LocalEnv);
6426- TypeCode_free(Self, @LocalEnv);
6427- SOM_UninitEnvironmentOrRaise(@LocalEnv);
6428-end;
6429-
64306719 procedure TypeCode_print(t: TypeCode; ev: PEnvironment); stdcall; external SOMTC_DLL_Name name 'tcPrint';
64316720
64326721 procedure TypeCode.Print;
diff -r c34e53e000f0 -r bfeeb6eebca5 SOMIRIMP.dpr
--- a/SOMIRIMP.dpr Sun Oct 30 00:46:17 2016 +0700
+++ b/SOMIRIMP.dpr Sun Oct 30 03:08:16 2016 +0700
@@ -2686,18 +2686,80 @@
26862686 WriteLn(F);
26872687 WriteLn(F, ' { Classes }');
26882688 WriteLn(F, ' SOMObjectBase = class');
2689- WriteLn(F, ' private');
2690- WriteLn(F, ' { hide TObject methods }');
2691- WriteLn(F, ' procedure Create; reintroduce;');
2692- WriteLn(F, ' procedure Destroy; reintroduce;'); // TODO hide others
2689+ WriteLn(F, ' { hide or reimplement TObject methods }');
2690+ WriteLn(F, ' protected');
2691+ WriteLn(F, ' class procedure Create; reintroduce;');
26932692 WriteLn(F, ' public');
2693+ WriteLn(F, ' procedure Free; reintroduce;');
2694+ WriteLn(F, ' protected');
2695+ WriteLn(F, ' class procedure InitInstance; reintroduce;');
2696+ WriteLn(F, ' public');
2697+ WriteLn(F, ' procedure CleanupInstance; reintroduce;');
2698+ WriteLn(F, ' function ClassType: SOMClass; reintroduce;');
2699+ WriteLn(F, ' protected');
2700+ WriteLn(F, ' class procedure ClassName; reintroduce;');
2701+ WriteLn(F, ' class procedure ClassNameIs; reintroduce;');
2702+ WriteLn(F, ' class procedure ClassParent; reintroduce;');
2703+ WriteLn(F, ' class procedure ClassInfo; reintroduce;');
2704+ WriteLn(F, ' class procedure InstanceSize; reintroduce;');
2705+ WriteLn(F, ' class procedure InheritsFrom; reintroduce;');
2706+ WriteLn(F, ' class procedure MethodAddress; reintroduce;');
2707+ WriteLn(F, ' class procedure MethodName; reintroduce;');
2708+ WriteLn(F, ' procedure FieldAddress; reintroduce;');
2709+ WriteLn(F, ' procedure GetInterface; reintroduce;');
2710+ WriteLn(F, ' class procedure GetInterfaceEntry; reintroduce;');
2711+ WriteLn(F, ' class procedure GetInterfaceTable; reintroduce;');
2712+ WriteLn(F, ' procedure SafeCallException; reintroduce;');
2713+ WriteLn(F, ' public');
2714+ WriteLn(F, ' procedure AfterConstruction; reintroduce;');
2715+ WriteLn(F, ' procedure BeforeDestruction; reintroduce;');
2716+ WriteLn(F, ' protected');
2717+ WriteLn(F, ' procedure Dispatch; reintroduce;');
2718+ WriteLn(F, ' procedure DefaultHandler; reintroduce;');
2719+ WriteLn(F, ' class procedure NewInstance; reintroduce;');
2720+ WriteLn(F, ' public');
2721+ WriteLn(F, ' procedure FreeInstance; reintroduce;');
2722+ WriteLn(F, ' procedure Destroy; reintroduce;');
2723+ WriteLn(F);
2724+ WriteLn(F, ' { Upcasting }');
26942725 WriteLn(F, ' function As_SOMObject: SOMObject; {$IFDEF DELPHI_HAS_INLINE} inline; {$ENDIF}');
26952726 WriteLn(F, ' end;');
26962727 WriteLn(F);
26972728 WriteLn(F, ' TypeCode = class');
2698- WriteLn(F, ' private');
2699- WriteLn(F, ' { hide TObject methods }');
2700- WriteLn(F, ' procedure Destroy; reintroduce;'); // TODO hide others
2729+ WriteLn(F, ' { hide or reimplement TObject methods }');
2730+ WriteLn(F, ' public');
2731+ WriteLn(F, ' procedure Free; reintroduce;');
2732+ WriteLn(F, ' protected');
2733+ WriteLn(F, ' class procedure InitInstance; reintroduce;');
2734+ WriteLn(F, ' public');
2735+ WriteLn(F, ' procedure CleanupInstance; reintroduce;');
2736+ WriteLn(F, ' protected');
2737+ WriteLn(F, ' procedure ClassType; reintroduce;');
2738+ WriteLn(F, ' public');
2739+ WriteLn(F, ' class function ClassName: string; reintroduce;');
2740+ WriteLn(F, ' class function ClassNameIs(const Name: string): Boolean; reintroduce;');
2741+ WriteLn(F, ' protected');
2742+ WriteLn(F, ' class procedure ClassParent; reintroduce;');
2743+ WriteLn(F, ' class procedure ClassInfo; reintroduce;');
2744+ WriteLn(F, ' class procedure InstanceSize; reintroduce;');
2745+ WriteLn(F, ' class procedure InheritsFrom; reintroduce;');
2746+ WriteLn(F, ' class procedure MethodAddress; reintroduce;');
2747+ WriteLn(F, ' class procedure MethodName; reintroduce;');
2748+ WriteLn(F, ' procedure FieldAddress; reintroduce;');
2749+ WriteLn(F, ' procedure GetInterface; reintroduce;');
2750+ WriteLn(F, ' class procedure GetInterfaceEntry; reintroduce;');
2751+ WriteLn(F, ' class procedure GetInterfaceTable; reintroduce;');
2752+ WriteLn(F, ' procedure SafeCallException; reintroduce;');
2753+ WriteLn(F, ' public');
2754+ WriteLn(F, ' procedure AfterConstruction; reintroduce;');
2755+ WriteLn(F, ' procedure BeforeDestruction; reintroduce;');
2756+ WriteLn(F, ' protected');
2757+ WriteLn(F, ' procedure Dispatch; reintroduce;');
2758+ WriteLn(F, ' procedure DefaultHandler; reintroduce;');
2759+ WriteLn(F, ' class procedure NewInstance; reintroduce;');
2760+ WriteLn(F, ' public');
2761+ WriteLn(F, ' procedure FreeInstance; reintroduce;');
2762+ WriteLn(F, ' procedure Destroy; reintroduce;');
27012763 WriteLn(F, ' protected');
27022764 WriteLn(F, ' function GetKind: TCKind;');
27032765 WriteLn(F, ' function GetParamCount: LongInt;');
@@ -2736,7 +2798,6 @@
27362798 WriteLn(F, ' class function TC_FullInterfaceDescription: TypeCode;');
27372799 WriteLn(F, ' function Equal(y: TypeCode): CORBABoolean;');
27382800 WriteLn(F, ' function Copy: TypeCode;');
2739- WriteLn(F, ' procedure Free;');
27402801 WriteLn(F, ' procedure Print;');
27412802 WriteLn(F, ' class function Create(tag: TCKind): TypeCode; overload;');
27422803 WriteLn(F, ' class function Create(tag: TCKind; const Arguments: array of const): TypeCode; overload;');
@@ -3025,14 +3086,129 @@
30253086 WriteLn(F, 'var');
30263087 WriteLn(F, ' DLLLoad_CriticalSection : Windows.TRTLCriticalSection;');
30273088 WriteLn(F);
3028- WriteLn(F, 'procedure SOMObjectBase.Create;');
3089+ WriteLn(F, 'class procedure SOMObjectBase.Create;');
30293090 WriteLn(F, 'begin');
30303091 WriteLn(F, ' { hide this method }');
30313092 WriteLn(F, 'end;');
30323093 WriteLn(F);
3094+ WriteLn(F, 'procedure SOMObjectBase.Free;');
3095+ WriteLn(F, 'begin');
3096+ WriteLn(F, ' if Assigned(Self) then SOMObject(Self).somFree;');
3097+ WriteLn(F, 'end;');
3098+ WriteLn(F);
3099+ WriteLn(F, 'class procedure SOMObjectBase.InitInstance;');
3100+ WriteLn(F, 'begin');
3101+ WriteLn(F, ' { hide this method }');
3102+ WriteLn(F, 'end;');
3103+ WriteLn(F);
3104+ WriteLn(F, 'procedure SOMObjectBase.CleanupInstance;');
3105+ WriteLn(F, 'begin');
3106+ WriteLn(F, ' { in SOM, everything is being cleaned up by destructors }');
3107+ WriteLn(F, 'end;');
3108+ WriteLn(F);
3109+ WriteLn(F, 'function SOMObjectBase.ClassType: SOMClass;');
3110+ WriteLn(F, 'begin');
3111+ WriteLn(F, ' Result := SOMObject(Self).somGetClass;');
3112+ WriteLn(F, 'end;');
3113+ WriteLn(F);
3114+ WriteLn(F, 'class procedure SOMObjectBase.ClassName;');
3115+ WriteLn(F, 'begin');
3116+ WriteLn(F, ' { hide this method }');
3117+ WriteLn(F, 'end;');
3118+ WriteLn(F);
3119+ WriteLn(F, 'class procedure SOMObjectBase.ClassNameIs;');
3120+ WriteLn(F, 'begin');
3121+ WriteLn(F, ' { hide this method }');
3122+ WriteLn(F, 'end;');
3123+ WriteLn(F);
3124+ WriteLn(F, 'class procedure SOMObjectBase.ClassParent;');
3125+ WriteLn(F, 'begin');
3126+ WriteLn(F, ' { hide this method }');
3127+ WriteLn(F, 'end;');
3128+ WriteLn(F);
3129+ WriteLn(F, 'class procedure SOMObjectBase.ClassInfo;');
3130+ WriteLn(F, 'begin');
3131+ WriteLn(F, ' { hide this method }');
3132+ WriteLn(F, 'end;');
3133+ WriteLn(F);
3134+ WriteLn(F, 'class procedure SOMObjectBase.InstanceSize;');
3135+ WriteLn(F, 'begin');
3136+ WriteLn(F, ' { hide this method }');
3137+ WriteLn(F, 'end;');
3138+ WriteLn(F);
3139+ WriteLn(F, 'class procedure SOMObjectBase.InheritsFrom;');
3140+ WriteLn(F, 'begin');
3141+ WriteLn(F, ' { hide this method }');
3142+ WriteLn(F, 'end;');
3143+ WriteLn(F);
3144+ WriteLn(F, 'class procedure SOMObjectBase.MethodAddress;');
3145+ WriteLn(F, 'begin');
3146+ WriteLn(F, ' { hide this method }');
3147+ WriteLn(F, 'end;');
3148+ WriteLn(F);
3149+ WriteLn(F, 'class procedure SOMObjectBase.MethodName;');
3150+ WriteLn(F, 'begin');
3151+ WriteLn(F, ' { hide this method }');
3152+ WriteLn(F, 'end;');
3153+ WriteLn(F);
3154+ WriteLn(F, 'procedure SOMObjectBase.FieldAddress;');
3155+ WriteLn(F, 'begin');
3156+ WriteLn(F, ' { hide this method }');
3157+ WriteLn(F, 'end;');
3158+ WriteLn(F);
3159+ WriteLn(F, 'procedure SOMObjectBase.GetInterface;');
3160+ WriteLn(F, 'begin');
3161+ WriteLn(F, ' { hide this method }');
3162+ WriteLn(F, 'end;');
3163+ WriteLn(F);
3164+ WriteLn(F, 'class procedure SOMObjectBase.GetInterfaceEntry;');
3165+ WriteLn(F, 'begin');
3166+ WriteLn(F, ' { hide this method }');
3167+ WriteLn(F, 'end;');
3168+ WriteLn(F);
3169+ WriteLn(F, 'class procedure SOMObjectBase.GetInterfaceTable;');
3170+ WriteLn(F, 'begin');
3171+ WriteLn(F, ' { hide this method }');
3172+ WriteLn(F, 'end;');
3173+ WriteLn(F);
3174+ WriteLn(F, 'procedure SOMObjectBase.SafeCallException;');
3175+ WriteLn(F, 'begin');
3176+ WriteLn(F, ' { hide this method }');
3177+ WriteLn(F, 'end;');
3178+ WriteLn(F);
3179+ WriteLn(F, 'procedure SOMObjectBase.AfterConstruction;');
3180+ WriteLn(F, 'begin');
3181+ WriteLn(F, ' { in SOM that is being done by cooperative metaclass }');
3182+ WriteLn(F, 'end;');
3183+ WriteLn(F);
3184+ WriteLn(F, 'procedure SOMObjectBase.BeforeDestruction;');
3185+ WriteLn(F, 'begin');
3186+ WriteLn(F, ' { in SOM that is being done by cooperative metaclass }');
3187+ WriteLn(F, 'end;');
3188+ WriteLn(F);
3189+ WriteLn(F, 'procedure SOMObjectBase.Dispatch;');
3190+ WriteLn(F, 'begin');
3191+ WriteLn(F, ' { hide this method }');
3192+ WriteLn(F, 'end;');
3193+ WriteLn(F);
3194+ WriteLn(F, 'procedure SOMObjectBase.DefaultHandler;');
3195+ WriteLn(F, 'begin');
3196+ WriteLn(F, ' { hide this method }');
3197+ WriteLn(F, 'end;');
3198+ WriteLn(F);
3199+ WriteLn(F, 'class procedure SOMObjectBase.NewInstance;');
3200+ WriteLn(F, 'begin');
3201+ WriteLn(F, ' { hide this method }');
3202+ WriteLn(F, 'end;');
3203+ WriteLn(F);
3204+ WriteLn(F, 'procedure SOMObjectBase.FreeInstance;');
3205+ WriteLn(F, 'begin');
3206+ WriteLn(F, ' SOMObject(Self).somGetClass.somDeallocate(PAnsiChar(Pointer(Self)));');
3207+ WriteLn(F, 'end;');
3208+ WriteLn(F);
30333209 WriteLn(F, 'procedure SOMObjectBase.Destroy;');
30343210 WriteLn(F, 'begin');
3035- WriteLn(F, ' { hide this method }');
3211+ WriteLn(F, ' SOMObject(Self).somFree;');
30363212 WriteLn(F, 'end;');
30373213 WriteLn(F);
30383214 WriteLn(F, 'function SOMObjectBase.As_SOMObject; {$IFDEF DELPHI_HAS_INLINE} inline; {$ENDIF}');
@@ -3060,9 +3236,133 @@
30603236 WriteLn(F, 'end;');
30613237 FDLLs.Add('somtc.dll');
30623238 WriteLn(F);
3239+ WriteLn(F, 'procedure TypeCode.Free;');
3240+ WriteLn(F, 'begin');
3241+ WriteLn(F, ' if Assigned(Self) then');
3242+ WriteLn(F, ' begin');
3243+ WriteLn(F, ' FreeInstance;');
3244+ WriteLn(F, ' end;');
3245+ WriteLn(F, 'end;');
3246+ WriteLn(F);
3247+ WriteLn(F, 'class procedure TypeCode.InitInstance;');
3248+ WriteLn(F, 'begin');
3249+ WriteLn(F, ' { hide this method }');
3250+ WriteLn(F, 'end;');
3251+ WriteLn(F);
3252+ WriteLn(F, 'procedure TypeCode.CleanupInstance;');
3253+ WriteLn(F, 'begin');
3254+ WriteLn(F, ' { TypeCode_free does everything at the same time, so no separate Cleanup }');
3255+ WriteLn(F, 'end;');
3256+ WriteLn(F);
3257+ WriteLn(F, 'procedure TypeCode.ClassType;');
3258+ WriteLn(F, 'begin');
3259+ WriteLn(F, ' { hide this method }');
3260+ WriteLn(F, 'end;');
3261+ WriteLn(F);
3262+ WriteLn(F, 'class function TypeCode.ClassName: string;');
3263+ WriteLn(F, 'begin');
3264+ WriteLn(F, ' Result := ''TypeCode'';');
3265+ WriteLn(F, 'end;');
3266+ WriteLn(F);
3267+ WriteLn(F, 'class function TypeCode.ClassNameIs(const Name: string): Boolean;');
3268+ WriteLn(F, 'begin');
3269+ WriteLn(F, ' Result := Name = ''TypeCode'';');
3270+ WriteLn(F, 'end;');
3271+ WriteLn(F);
3272+ WriteLn(F, 'class procedure TypeCode.ClassParent;');
3273+ WriteLn(F, 'begin');
3274+ WriteLn(F, ' { hide this method }');
3275+ WriteLn(F, 'end;');
3276+ WriteLn(F);
3277+ WriteLn(F, 'class procedure TypeCode.ClassInfo;');
3278+ WriteLn(F, 'begin');
3279+ WriteLn(F, ' { hide this method }');
3280+ WriteLn(F, 'end;');
3281+ WriteLn(F);
3282+ WriteLn(F, 'class procedure TypeCode.InstanceSize;');
3283+ WriteLn(F, 'begin');
3284+ WriteLn(F, ' { hide this method }');
3285+ WriteLn(F, 'end;');
3286+ WriteLn(F);
3287+ WriteLn(F, 'class procedure TypeCode.InheritsFrom;');
3288+ WriteLn(F, 'begin');
3289+ WriteLn(F, ' { hide this method }');
3290+ WriteLn(F, 'end;');
3291+ WriteLn(F);
3292+ WriteLn(F, 'class procedure TypeCode.MethodAddress;');
3293+ WriteLn(F, 'begin');
3294+ WriteLn(F, ' { hide this method }');
3295+ WriteLn(F, 'end;');
3296+ WriteLn(F);
3297+ WriteLn(F, 'class procedure TypeCode.MethodName;');
3298+ WriteLn(F, 'begin');
3299+ WriteLn(F, ' { hide this method }');
3300+ WriteLn(F, 'end;');
3301+ WriteLn(F);
3302+ WriteLn(F, 'procedure TypeCode.FieldAddress;');
3303+ WriteLn(F, 'begin');
3304+ WriteLn(F, ' { hide this method }');
3305+ WriteLn(F, 'end;');
3306+ WriteLn(F);
3307+ WriteLn(F, 'procedure TypeCode.GetInterface;');
3308+ WriteLn(F, 'begin');
3309+ WriteLn(F, ' { hide this method }');
3310+ WriteLn(F, 'end;');
3311+ WriteLn(F);
3312+ WriteLn(F, 'class procedure TypeCode.GetInterfaceEntry;');
3313+ WriteLn(F, 'begin');
3314+ WriteLn(F, ' { hide this method }');
3315+ WriteLn(F, 'end;');
3316+ WriteLn(F);
3317+ WriteLn(F, 'class procedure TypeCode.GetInterfaceTable;');
3318+ WriteLn(F, 'begin');
3319+ WriteLn(F, ' { hide this method }');
3320+ WriteLn(F, 'end;');
3321+ WriteLn(F);
3322+ WriteLn(F, 'procedure TypeCode.SafeCallException;');
3323+ WriteLn(F, 'begin');
3324+ WriteLn(F, ' { hide this method }');
3325+ WriteLn(F, 'end;');
3326+ WriteLn(F);
3327+ WriteLn(F, 'procedure TypeCode.AfterConstruction;');
3328+ WriteLn(F, 'begin');
3329+ WriteLn(F, ' { nothing to do }');
3330+ WriteLn(F, 'end;');
3331+ WriteLn(F);
3332+ WriteLn(F, 'procedure TypeCode.BeforeDestruction;');
3333+ WriteLn(F, 'begin');
3334+ WriteLn(F, ' { nothing to do }');
3335+ WriteLn(F, 'end;');
3336+ WriteLn(F);
3337+ WriteLn(F, 'procedure TypeCode.Dispatch;');
3338+ WriteLn(F, 'begin');
3339+ WriteLn(F, ' { hide this method }');
3340+ WriteLn(F, 'end;');
3341+ WriteLn(F);
3342+ WriteLn(F, 'procedure TypeCode.DefaultHandler;');
3343+ WriteLn(F, 'begin');
3344+ WriteLn(F, ' { hide this method }');
3345+ WriteLn(F, 'end;');
3346+ WriteLn(F);
3347+ WriteLn(F, 'class procedure TypeCode.NewInstance;');
3348+ WriteLn(F, 'begin');
3349+ WriteLn(F, ' { hide this method }');
3350+ WriteLn(F, 'end;');
3351+ WriteLn(F);
3352+ WriteLn(F, 'procedure TypeCode_free(t: TypeCode; ev: PEnvironment); stdcall; external SOMTC_DLL_Name name ''tcFree'';');
3353+ WriteLn(F);
3354+ WriteLn(F, 'procedure TypeCode.FreeInstance;');
3355+ WriteLn(F, 'var');
3356+ WriteLn(F, ' LocalEnv: Environment;');
3357+ WriteLn(F, 'begin');
3358+ WriteLn(F, ' SOM_InitEnvironment(@LocalEnv);');
3359+ WriteLn(F, ' TypeCode_free(Self, @LocalEnv);');
3360+ WriteLn(F, ' SOM_UninitEnvironmentOrRaise(@LocalEnv);');
3361+ WriteLn(F, 'end;');
3362+ WriteLn(F);
30633363 WriteLn(F, 'procedure TypeCode.Destroy;');
30643364 WriteLn(F, 'begin');
3065- WriteLn(F, ' { hide this method }'); // TODO free?
3365+ WriteLn(F, ' FreeInstance;');
30663366 WriteLn(F, 'end;');
30673367 WriteLn(F);
30683368 WriteLn(F, 'function TypeCode_kind(t: TypeCode; ev: PEnvironment): TCKind; stdcall; external SOMTC_DLL_Name name ''tcKind'';');
@@ -3545,17 +3845,6 @@
35453845 WriteLn(F, ' SOM_UninitEnvironmentOrRaise(@LocalEnv);');
35463846 WriteLn(F, 'end;');
35473847 WriteLn(F);
3548- WriteLn(F, 'procedure TypeCode_free(t: TypeCode; ev: PEnvironment); stdcall; external SOMTC_DLL_Name name ''tcFree'';');
3549- WriteLn(F);
3550- WriteLn(F, 'procedure TypeCode.Free;');
3551- WriteLn(F, 'var');
3552- WriteLn(F, ' LocalEnv: Environment;');
3553- WriteLn(F, 'begin');
3554- WriteLn(F, ' SOM_InitEnvironment(@LocalEnv);');
3555- WriteLn(F, ' TypeCode_free(Self, @LocalEnv);');
3556- WriteLn(F, ' SOM_UninitEnvironmentOrRaise(@LocalEnv);');
3557- WriteLn(F, 'end;');
3558- WriteLn(F);
35593848 WriteLn(F, 'procedure TypeCode_print(t: TypeCode; ev: PEnvironment); stdcall; external SOMTC_DLL_Name name ''tcPrint'';');
35603849 WriteLn(F);
35613850 WriteLn(F, 'procedure TypeCode.Print;');
@@ -4045,7 +4334,6 @@
40454334
40464335 begin
40474336 try
4048- WriteLn('Testing SOMObject v', SOM_MajorVersion, '.', SOM_MinorVersion);
40494337 SOM_MainProgram;
40504338 TestSOM_IR;
40514339 except
diff -r c34e53e000f0 -r bfeeb6eebca5 SOMIRTest.DumpOut.pas
--- a/SOMIRTest.DumpOut.pas Sun Oct 30 00:46:17 2016 +0700
+++ b/SOMIRTest.DumpOut.pas Sun Oct 30 03:08:16 2016 +0700
@@ -784,17 +784,79 @@
784784
785785 { Classes }
786786 SOMObjectBase = class
787- private
788- { hide TObject methods }
789- procedure Create; reintroduce;
787+ { hide or reimplement TObject methods }
788+ protected
789+ class procedure Create; reintroduce;
790+ public
791+ procedure Free; reintroduce;
792+ protected
793+ class procedure InitInstance; reintroduce;
794+ public
795+ procedure CleanupInstance; reintroduce;
796+ function ClassType: SOMClass; reintroduce;
797+ protected
798+ class procedure ClassName; reintroduce;
799+ class procedure ClassNameIs; reintroduce;
800+ class procedure ClassParent; reintroduce;
801+ class procedure ClassInfo; reintroduce;
802+ class procedure InstanceSize; reintroduce;
803+ class procedure InheritsFrom; reintroduce;
804+ class procedure MethodAddress; reintroduce;
805+ class procedure MethodName; reintroduce;
806+ procedure FieldAddress; reintroduce;
807+ procedure GetInterface; reintroduce;
808+ class procedure GetInterfaceEntry; reintroduce;
809+ class procedure GetInterfaceTable; reintroduce;
810+ procedure SafeCallException; reintroduce;
811+ public
812+ procedure AfterConstruction; reintroduce;
813+ procedure BeforeDestruction; reintroduce;
814+ protected
815+ procedure Dispatch; reintroduce;
816+ procedure DefaultHandler; reintroduce;
817+ class procedure NewInstance; reintroduce;
818+ public
819+ procedure FreeInstance; reintroduce;
790820 procedure Destroy; reintroduce;
791- public
821+
822+ { Upcasting }
792823 function As_SOMObject: SOMObject; {$IFDEF DELPHI_HAS_INLINE} inline; {$ENDIF}
793824 end;
794825
795826 TypeCode = class
796- private
797- { hide TObject methods }
827+ { hide or reimplement TObject methods }
828+ public
829+ procedure Free; reintroduce;
830+ protected
831+ class procedure InitInstance; reintroduce;
832+ public
833+ procedure CleanupInstance; reintroduce;
834+ protected
835+ procedure ClassType; reintroduce;
836+ public
837+ class function ClassName: string; reintroduce;
838+ class function ClassNameIs(const Name: string): Boolean; reintroduce;
839+ protected
840+ class procedure ClassParent; reintroduce;
841+ class procedure ClassInfo; reintroduce;
842+ class procedure InstanceSize; reintroduce;
843+ class procedure InheritsFrom; reintroduce;
844+ class procedure MethodAddress; reintroduce;
845+ class procedure MethodName; reintroduce;
846+ procedure FieldAddress; reintroduce;
847+ procedure GetInterface; reintroduce;
848+ class procedure GetInterfaceEntry; reintroduce;
849+ class procedure GetInterfaceTable; reintroduce;
850+ procedure SafeCallException; reintroduce;
851+ public
852+ procedure AfterConstruction; reintroduce;
853+ procedure BeforeDestruction; reintroduce;
854+ protected
855+ procedure Dispatch; reintroduce;
856+ procedure DefaultHandler; reintroduce;
857+ class procedure NewInstance; reintroduce;
858+ public
859+ procedure FreeInstance; reintroduce;
798860 procedure Destroy; reintroduce;
799861 protected
800862 function GetKind: TCKind;
@@ -834,7 +896,6 @@
834896 class function TC_FullInterfaceDescription: TypeCode;
835897 function Equal(y: TypeCode): CORBABoolean;
836898 function Copy: TypeCode;
837- procedure Free;
838899 procedure Print;
839900 class function Create(tag: TCKind): TypeCode; overload;
840901 class function Create(tag: TCKind; const Arguments: array of const): TypeCode; overload;
@@ -5897,14 +5958,129 @@
58975958 var
58985959 DLLLoad_CriticalSection : Windows.TRTLCriticalSection;
58995960
5900-procedure SOMObjectBase.Create;
5961+class procedure SOMObjectBase.Create;
59015962 begin
59025963 { hide this method }
59035964 end;
59045965
5966+procedure SOMObjectBase.Free;
5967+begin
5968+ if Assigned(Self) then SOMObject(Self).somFree;
5969+end;
5970+
5971+class procedure SOMObjectBase.InitInstance;
5972+begin
5973+ { hide this method }
5974+end;
5975+
5976+procedure SOMObjectBase.CleanupInstance;
5977+begin
5978+ { in SOM, everything is being cleaned up by destructors }
5979+end;
5980+
5981+function SOMObjectBase.ClassType: SOMClass;
5982+begin
5983+ Result := SOMObject(Self).somGetClass;
5984+end;
5985+
5986+class procedure SOMObjectBase.ClassName;
5987+begin
5988+ { hide this method }
5989+end;
5990+
5991+class procedure SOMObjectBase.ClassNameIs;
5992+begin
5993+ { hide this method }
5994+end;
5995+
5996+class procedure SOMObjectBase.ClassParent;
5997+begin
5998+ { hide this method }
5999+end;
6000+
6001+class procedure SOMObjectBase.ClassInfo;
6002+begin
6003+ { hide this method }
6004+end;
6005+
6006+class procedure SOMObjectBase.InstanceSize;
6007+begin
6008+ { hide this method }
6009+end;
6010+
6011+class procedure SOMObjectBase.InheritsFrom;
6012+begin
6013+ { hide this method }
6014+end;
6015+
6016+class procedure SOMObjectBase.MethodAddress;
6017+begin
6018+ { hide this method }
6019+end;
6020+
6021+class procedure SOMObjectBase.MethodName;
6022+begin
6023+ { hide this method }
6024+end;
6025+
6026+procedure SOMObjectBase.FieldAddress;
6027+begin
6028+ { hide this method }
6029+end;
6030+
6031+procedure SOMObjectBase.GetInterface;
6032+begin
6033+ { hide this method }
6034+end;
6035+
6036+class procedure SOMObjectBase.GetInterfaceEntry;
6037+begin
6038+ { hide this method }
6039+end;
6040+
6041+class procedure SOMObjectBase.GetInterfaceTable;
6042+begin
6043+ { hide this method }
6044+end;
6045+
6046+procedure SOMObjectBase.SafeCallException;
6047+begin
6048+ { hide this method }
6049+end;
6050+
6051+procedure SOMObjectBase.AfterConstruction;
6052+begin
6053+ { in SOM that is being done by cooperative metaclass }
6054+end;
6055+
6056+procedure SOMObjectBase.BeforeDestruction;
6057+begin
6058+ { in SOM that is being done by cooperative metaclass }
6059+end;
6060+
6061+procedure SOMObjectBase.Dispatch;
6062+begin
6063+ { hide this method }
6064+end;
6065+
6066+procedure SOMObjectBase.DefaultHandler;
6067+begin
6068+ { hide this method }
6069+end;
6070+
6071+class procedure SOMObjectBase.NewInstance;
6072+begin
6073+ { hide this method }
6074+end;
6075+
6076+procedure SOMObjectBase.FreeInstance;
6077+begin
6078+ SOMObject(Self).somGetClass.somDeallocate(PAnsiChar(Pointer(Self)));
6079+end;
6080+
59056081 procedure SOMObjectBase.Destroy;
59066082 begin
5907- { hide this method }
6083+ SOMObject(Self).somFree;
59086084 end;
59096085
59106086 function SOMObjectBase.As_SOMObject; {$IFDEF DELPHI_HAS_INLINE} inline; {$ENDIF}
@@ -5931,11 +6107,135 @@
59316107 Pointer(V_Pointer) := Windows.GetProcAddress(SOMTC_DLL, PAnsiChar(Var_Name));
59326108 end;
59336109
5934-procedure TypeCode.Destroy;
6110+procedure TypeCode.Free;
6111+begin
6112+ if Assigned(Self) then
6113+ begin
6114+ FreeInstance;
6115+ end;
6116+end;
6117+
6118+class procedure TypeCode.InitInstance;
59356119 begin
59366120 { hide this method }
59376121 end;
59386122
6123+procedure TypeCode.CleanupInstance;
6124+begin
6125+ { TypeCode_free does everything at the same time, so no separate Cleanup }
6126+end;
6127+
6128+procedure TypeCode.ClassType;
6129+begin
6130+ { hide this method }
6131+end;
6132+
6133+class function TypeCode.ClassName: string;
6134+begin
6135+ Result := 'TypeCode';
6136+end;
6137+
6138+class function TypeCode.ClassNameIs(const Name: string): Boolean;
6139+begin
6140+ Result := Name = 'TypeCode';
6141+end;
6142+
6143+class procedure TypeCode.ClassParent;
6144+begin
6145+ { hide this method }
6146+end;
6147+
6148+class procedure TypeCode.ClassInfo;
6149+begin
6150+ { hide this method }
6151+end;
6152+
6153+class procedure TypeCode.InstanceSize;
6154+begin
6155+ { hide this method }
6156+end;
6157+
6158+class procedure TypeCode.InheritsFrom;
6159+begin
6160+ { hide this method }
6161+end;
6162+
6163+class procedure TypeCode.MethodAddress;
6164+begin
6165+ { hide this method }
6166+end;
6167+
6168+class procedure TypeCode.MethodName;
6169+begin
6170+ { hide this method }
6171+end;
6172+
6173+procedure TypeCode.FieldAddress;
6174+begin
6175+ { hide this method }
6176+end;
6177+
6178+procedure TypeCode.GetInterface;
6179+begin
6180+ { hide this method }
6181+end;
6182+
6183+class procedure TypeCode.GetInterfaceEntry;
6184+begin
6185+ { hide this method }
6186+end;
6187+
6188+class procedure TypeCode.GetInterfaceTable;
6189+begin
6190+ { hide this method }
6191+end;
6192+
6193+procedure TypeCode.SafeCallException;
6194+begin
6195+ { hide this method }
6196+end;
6197+
6198+procedure TypeCode.AfterConstruction;
6199+begin
6200+ { nothing to do }
6201+end;
6202+
6203+procedure TypeCode.BeforeDestruction;
6204+begin
6205+ { nothing to do }
6206+end;
6207+
6208+procedure TypeCode.Dispatch;
6209+begin
6210+ { hide this method }
6211+end;
6212+
6213+procedure TypeCode.DefaultHandler;
6214+begin
6215+ { hide this method }
6216+end;
6217+
6218+class procedure TypeCode.NewInstance;
6219+begin
6220+ { hide this method }
6221+end;
6222+
6223+procedure TypeCode_free(t: TypeCode; ev: PEnvironment); stdcall; external SOMTC_DLL_Name name 'tcFree';
6224+
6225+procedure TypeCode.FreeInstance;
6226+var
6227+ LocalEnv: Environment;
6228+begin
6229+ SOM_InitEnvironment(@LocalEnv);
6230+ TypeCode_free(Self, @LocalEnv);
6231+ SOM_UninitEnvironmentOrRaise(@LocalEnv);
6232+end;
6233+
6234+procedure TypeCode.Destroy;
6235+begin
6236+ FreeInstance;
6237+end;
6238+
59396239 function TypeCode_kind(t: TypeCode; ev: PEnvironment): TCKind; stdcall; external SOMTC_DLL_Name name 'tcKind';
59406240
59416241 function TypeCode.GetKind: TCKind;
@@ -6416,17 +6716,6 @@
64166716 SOM_UninitEnvironmentOrRaise(@LocalEnv);
64176717 end;
64186718
6419-procedure TypeCode_free(t: TypeCode; ev: PEnvironment); stdcall; external SOMTC_DLL_Name name 'tcFree';
6420-
6421-procedure TypeCode.Free;
6422-var
6423- LocalEnv: Environment;
6424-begin
6425- SOM_InitEnvironment(@LocalEnv);
6426- TypeCode_free(Self, @LocalEnv);
6427- SOM_UninitEnvironmentOrRaise(@LocalEnv);
6428-end;
6429-
64306719 procedure TypeCode_print(t: TypeCode; ev: PEnvironment); stdcall; external SOMTC_DLL_Name name 'tcPrint';
64316720
64326721 procedure TypeCode.Print;
diff -r c34e53e000f0 -r bfeeb6eebca5 SOMIRTest.IRTestOut.DumpOut.pas
--- a/SOMIRTest.IRTestOut.DumpOut.pas Sun Oct 30 00:46:17 2016 +0700
+++ b/SOMIRTest.IRTestOut.DumpOut.pas Sun Oct 30 03:08:16 2016 +0700
@@ -784,17 +784,79 @@
784784
785785 { Classes }
786786 SOMObjectBase = class
787- private
788- { hide TObject methods }
789- procedure Create; reintroduce;
787+ { hide or reimplement TObject methods }
788+ protected
789+ class procedure Create; reintroduce;
790+ public
791+ procedure Free; reintroduce;
792+ protected
793+ class procedure InitInstance; reintroduce;
794+ public
795+ procedure CleanupInstance; reintroduce;
796+ function ClassType: SOMClass; reintroduce;
797+ protected
798+ class procedure ClassName; reintroduce;
799+ class procedure ClassNameIs; reintroduce;
800+ class procedure ClassParent; reintroduce;
801+ class procedure ClassInfo; reintroduce;
802+ class procedure InstanceSize; reintroduce;
803+ class procedure InheritsFrom; reintroduce;
804+ class procedure MethodAddress; reintroduce;
805+ class procedure MethodName; reintroduce;
806+ procedure FieldAddress; reintroduce;
807+ procedure GetInterface; reintroduce;
808+ class procedure GetInterfaceEntry; reintroduce;
809+ class procedure GetInterfaceTable; reintroduce;
810+ procedure SafeCallException; reintroduce;
811+ public
812+ procedure AfterConstruction; reintroduce;
813+ procedure BeforeDestruction; reintroduce;
814+ protected
815+ procedure Dispatch; reintroduce;
816+ procedure DefaultHandler; reintroduce;
817+ class procedure NewInstance; reintroduce;
818+ public
819+ procedure FreeInstance; reintroduce;
790820 procedure Destroy; reintroduce;
791- public
821+
822+ { Upcasting }
792823 function As_SOMObject: SOMObject; {$IFDEF DELPHI_HAS_INLINE} inline; {$ENDIF}
793824 end;
794825
795826 TypeCode = class
796- private
797- { hide TObject methods }
827+ { hide or reimplement TObject methods }
828+ public
829+ procedure Free; reintroduce;
830+ protected
831+ class procedure InitInstance; reintroduce;
832+ public
833+ procedure CleanupInstance; reintroduce;
834+ protected
835+ procedure ClassType; reintroduce;
836+ public
837+ class function ClassName: string; reintroduce;
838+ class function ClassNameIs(const Name: string): Boolean; reintroduce;
839+ protected
840+ class procedure ClassParent; reintroduce;
841+ class procedure ClassInfo; reintroduce;
842+ class procedure InstanceSize; reintroduce;
843+ class procedure InheritsFrom; reintroduce;
844+ class procedure MethodAddress; reintroduce;
845+ class procedure MethodName; reintroduce;
846+ procedure FieldAddress; reintroduce;
847+ procedure GetInterface; reintroduce;
848+ class procedure GetInterfaceEntry; reintroduce;
849+ class procedure GetInterfaceTable; reintroduce;
850+ procedure SafeCallException; reintroduce;
851+ public
852+ procedure AfterConstruction; reintroduce;
853+ procedure BeforeDestruction; reintroduce;
854+ protected
855+ procedure Dispatch; reintroduce;
856+ procedure DefaultHandler; reintroduce;
857+ class procedure NewInstance; reintroduce;
858+ public
859+ procedure FreeInstance; reintroduce;
798860 procedure Destroy; reintroduce;
799861 protected
800862 function GetKind: TCKind;
@@ -834,7 +896,6 @@
834896 class function TC_FullInterfaceDescription: TypeCode;
835897 function Equal(y: TypeCode): CORBABoolean;
836898 function Copy: TypeCode;
837- procedure Free;
838899 procedure Print;
839900 class function Create(tag: TCKind): TypeCode; overload;
840901 class function Create(tag: TCKind; const Arguments: array of const): TypeCode; overload;
@@ -5897,14 +5958,129 @@
58975958 var
58985959 DLLLoad_CriticalSection : Windows.TRTLCriticalSection;
58995960
5900-procedure SOMObjectBase.Create;
5961+class procedure SOMObjectBase.Create;
59015962 begin
59025963 { hide this method }
59035964 end;
59045965
5966+procedure SOMObjectBase.Free;
5967+begin
5968+ if Assigned(Self) then SOMObject(Self).somFree;
5969+end;
5970+
5971+class procedure SOMObjectBase.InitInstance;
5972+begin
5973+ { hide this method }
5974+end;
5975+
5976+procedure SOMObjectBase.CleanupInstance;
5977+begin
5978+ { in SOM, everything is being cleaned up by destructors }
5979+end;
5980+
5981+function SOMObjectBase.ClassType: SOMClass;
5982+begin
5983+ Result := SOMObject(Self).somGetClass;
5984+end;
5985+
5986+class procedure SOMObjectBase.ClassName;
5987+begin
5988+ { hide this method }
5989+end;
5990+
5991+class procedure SOMObjectBase.ClassNameIs;
5992+begin
5993+ { hide this method }
5994+end;
5995+
5996+class procedure SOMObjectBase.ClassParent;
5997+begin
5998+ { hide this method }
5999+end;
6000+
6001+class procedure SOMObjectBase.ClassInfo;
6002+begin
6003+ { hide this method }
6004+end;
6005+
6006+class procedure SOMObjectBase.InstanceSize;
6007+begin
6008+ { hide this method }
6009+end;
6010+
6011+class procedure SOMObjectBase.InheritsFrom;
6012+begin
6013+ { hide this method }
6014+end;
6015+
6016+class procedure SOMObjectBase.MethodAddress;
6017+begin
6018+ { hide this method }
6019+end;
6020+
6021+class procedure SOMObjectBase.MethodName;
6022+begin
6023+ { hide this method }
6024+end;
6025+
6026+procedure SOMObjectBase.FieldAddress;
6027+begin
6028+ { hide this method }
6029+end;
6030+
6031+procedure SOMObjectBase.GetInterface;
6032+begin
6033+ { hide this method }
6034+end;
6035+
6036+class procedure SOMObjectBase.GetInterfaceEntry;
6037+begin
6038+ { hide this method }
6039+end;
6040+
6041+class procedure SOMObjectBase.GetInterfaceTable;
6042+begin
6043+ { hide this method }
6044+end;
6045+
6046+procedure SOMObjectBase.SafeCallException;
6047+begin
6048+ { hide this method }
6049+end;
6050+
6051+procedure SOMObjectBase.AfterConstruction;
6052+begin
6053+ { in SOM that is being done by cooperative metaclass }
6054+end;
6055+
6056+procedure SOMObjectBase.BeforeDestruction;
6057+begin
6058+ { in SOM that is being done by cooperative metaclass }
6059+end;
6060+
6061+procedure SOMObjectBase.Dispatch;
6062+begin
6063+ { hide this method }
6064+end;
6065+
6066+procedure SOMObjectBase.DefaultHandler;
6067+begin
6068+ { hide this method }
6069+end;
6070+
6071+class procedure SOMObjectBase.NewInstance;
6072+begin
6073+ { hide this method }
6074+end;
6075+
6076+procedure SOMObjectBase.FreeInstance;
6077+begin
6078+ SOMObject(Self).somGetClass.somDeallocate(PAnsiChar(Pointer(Self)));
6079+end;
6080+
59056081 procedure SOMObjectBase.Destroy;
59066082 begin
5907- { hide this method }
6083+ SOMObject(Self).somFree;
59086084 end;
59096085
59106086 function SOMObjectBase.As_SOMObject; {$IFDEF DELPHI_HAS_INLINE} inline; {$ENDIF}
@@ -5931,11 +6107,135 @@
59316107 Pointer(V_Pointer) := Windows.GetProcAddress(SOMTC_DLL, PAnsiChar(Var_Name));
59326108 end;
59336109
5934-procedure TypeCode.Destroy;
6110+procedure TypeCode.Free;
6111+begin
6112+ if Assigned(Self) then
6113+ begin
6114+ FreeInstance;
6115+ end;
6116+end;
6117+
6118+class procedure TypeCode.InitInstance;
59356119 begin
59366120 { hide this method }
59376121 end;
59386122
6123+procedure TypeCode.CleanupInstance;
6124+begin
6125+ { TypeCode_free does everything at the same time, so no separate Cleanup }
6126+end;
6127+
6128+procedure TypeCode.ClassType;
6129+begin
6130+ { hide this method }
6131+end;
6132+
6133+class function TypeCode.ClassName: string;
6134+begin
6135+ Result := 'TypeCode';
6136+end;
6137+
6138+class function TypeCode.ClassNameIs(const Name: string): Boolean;
6139+begin
6140+ Result := Name = 'TypeCode';
6141+end;
6142+
6143+class procedure TypeCode.ClassParent;
6144+begin
6145+ { hide this method }
6146+end;
6147+
6148+class procedure TypeCode.ClassInfo;
6149+begin
6150+ { hide this method }
6151+end;
6152+
6153+class procedure TypeCode.InstanceSize;
6154+begin
6155+ { hide this method }
6156+end;
6157+
6158+class procedure TypeCode.InheritsFrom;
6159+begin
6160+ { hide this method }
6161+end;
6162+
6163+class procedure TypeCode.MethodAddress;
6164+begin
6165+ { hide this method }
6166+end;
6167+
6168+class procedure TypeCode.MethodName;
6169+begin
6170+ { hide this method }
6171+end;
6172+
6173+procedure TypeCode.FieldAddress;
6174+begin
6175+ { hide this method }
6176+end;
6177+
6178+procedure TypeCode.GetInterface;
6179+begin
6180+ { hide this method }
6181+end;
6182+
6183+class procedure TypeCode.GetInterfaceEntry;
6184+begin
6185+ { hide this method }
6186+end;
6187+
6188+class procedure TypeCode.GetInterfaceTable;
6189+begin
6190+ { hide this method }
6191+end;
6192+
6193+procedure TypeCode.SafeCallException;
6194+begin
6195+ { hide this method }
6196+end;
6197+
6198+procedure TypeCode.AfterConstruction;
6199+begin
6200+ { nothing to do }
6201+end;
6202+
6203+procedure TypeCode.BeforeDestruction;
6204+begin
6205+ { nothing to do }
6206+end;
6207+
6208+procedure TypeCode.Dispatch;
6209+begin
6210+ { hide this method }
6211+end;
6212+
6213+procedure TypeCode.DefaultHandler;
6214+begin
6215+ { hide this method }
6216+end;
6217+
6218+class procedure TypeCode.NewInstance;
6219+begin
6220+ { hide this method }
6221+end;
6222+
6223+procedure TypeCode_free(t: TypeCode; ev: PEnvironment); stdcall; external SOMTC_DLL_Name name 'tcFree';
6224+
6225+procedure TypeCode.FreeInstance;
6226+var
6227+ LocalEnv: Environment;
6228+begin
6229+ SOM_InitEnvironment(@LocalEnv);
6230+ TypeCode_free(Self, @LocalEnv);
6231+ SOM_UninitEnvironmentOrRaise(@LocalEnv);
6232+end;
6233+
6234+procedure TypeCode.Destroy;
6235+begin
6236+ FreeInstance;
6237+end;
6238+
59396239 function TypeCode_kind(t: TypeCode; ev: PEnvironment): TCKind; stdcall; external SOMTC_DLL_Name name 'tcKind';
59406240
59416241 function TypeCode.GetKind: TCKind;
@@ -6416,17 +6716,6 @@
64166716 SOM_UninitEnvironmentOrRaise(@LocalEnv);
64176717 end;
64186718
6419-procedure TypeCode_free(t: TypeCode; ev: PEnvironment); stdcall; external SOMTC_DLL_Name name 'tcFree';
6420-
6421-procedure TypeCode.Free;
6422-var
6423- LocalEnv: Environment;
6424-begin
6425- SOM_InitEnvironment(@LocalEnv);
6426- TypeCode_free(Self, @LocalEnv);
6427- SOM_UninitEnvironmentOrRaise(@LocalEnv);
6428-end;
6429-
64306719 procedure TypeCode_print(t: TypeCode; ev: PEnvironment); stdcall; external SOMTC_DLL_Name name 'tcPrint';
64316720
64326721 procedure TypeCode.Print;
diff -r c34e53e000f0 -r bfeeb6eebca5 SOMIRTest.IRTestOut.dpr
--- a/SOMIRTest.IRTestOut.dpr Sun Oct 30 00:46:17 2016 +0700
+++ b/SOMIRTest.IRTestOut.dpr Sun Oct 30 03:08:16 2016 +0700
@@ -2686,18 +2686,80 @@
26862686 WriteLn(F);
26872687 WriteLn(F, ' { Classes }');
26882688 WriteLn(F, ' SOMObjectBase = class');
2689- WriteLn(F, ' private');
2690- WriteLn(F, ' { hide TObject methods }');
2691- WriteLn(F, ' procedure Create; reintroduce;');
2692- WriteLn(F, ' procedure Destroy; reintroduce;'); // TODO hide others
2689+ WriteLn(F, ' { hide or reimplement TObject methods }');
2690+ WriteLn(F, ' protected');
2691+ WriteLn(F, ' class procedure Create; reintroduce;');
26932692 WriteLn(F, ' public');
2693+ WriteLn(F, ' procedure Free; reintroduce;');
2694+ WriteLn(F, ' protected');
2695+ WriteLn(F, ' class procedure InitInstance; reintroduce;');
2696+ WriteLn(F, ' public');
2697+ WriteLn(F, ' procedure CleanupInstance; reintroduce;');
2698+ WriteLn(F, ' function ClassType: SOMClass; reintroduce;');
2699+ WriteLn(F, ' protected');
2700+ WriteLn(F, ' class procedure ClassName; reintroduce;');
2701+ WriteLn(F, ' class procedure ClassNameIs; reintroduce;');
2702+ WriteLn(F, ' class procedure ClassParent; reintroduce;');
2703+ WriteLn(F, ' class procedure ClassInfo; reintroduce;');
2704+ WriteLn(F, ' class procedure InstanceSize; reintroduce;');
2705+ WriteLn(F, ' class procedure InheritsFrom; reintroduce;');
2706+ WriteLn(F, ' class procedure MethodAddress; reintroduce;');
2707+ WriteLn(F, ' class procedure MethodName; reintroduce;');
2708+ WriteLn(F, ' procedure FieldAddress; reintroduce;');
2709+ WriteLn(F, ' procedure GetInterface; reintroduce;');
2710+ WriteLn(F, ' class procedure GetInterfaceEntry; reintroduce;');
2711+ WriteLn(F, ' class procedure GetInterfaceTable; reintroduce;');
2712+ WriteLn(F, ' procedure SafeCallException; reintroduce;');
2713+ WriteLn(F, ' public');
2714+ WriteLn(F, ' procedure AfterConstruction; reintroduce;');
2715+ WriteLn(F, ' procedure BeforeDestruction; reintroduce;');
2716+ WriteLn(F, ' protected');
2717+ WriteLn(F, ' procedure Dispatch; reintroduce;');
2718+ WriteLn(F, ' procedure DefaultHandler; reintroduce;');
2719+ WriteLn(F, ' class procedure NewInstance; reintroduce;');
2720+ WriteLn(F, ' public');
2721+ WriteLn(F, ' procedure FreeInstance; reintroduce;');
2722+ WriteLn(F, ' procedure Destroy; reintroduce;');
2723+ WriteLn(F);
2724+ WriteLn(F, ' { Upcasting }');
26942725 WriteLn(F, ' function As_SOMObject: SOMObject; {$IFDEF DELPHI_HAS_INLINE} inline; {$ENDIF}');
26952726 WriteLn(F, ' end;');
26962727 WriteLn(F);
26972728 WriteLn(F, ' TypeCode = class');
2698- WriteLn(F, ' private');
2699- WriteLn(F, ' { hide TObject methods }');
2700- WriteLn(F, ' procedure Destroy; reintroduce;'); // TODO hide others
2729+ WriteLn(F, ' { hide or reimplement TObject methods }');
2730+ WriteLn(F, ' public');
2731+ WriteLn(F, ' procedure Free; reintroduce;');
2732+ WriteLn(F, ' protected');
2733+ WriteLn(F, ' class procedure InitInstance; reintroduce;');
2734+ WriteLn(F, ' public');
2735+ WriteLn(F, ' procedure CleanupInstance; reintroduce;');
2736+ WriteLn(F, ' protected');
2737+ WriteLn(F, ' procedure ClassType; reintroduce;');
2738+ WriteLn(F, ' public');
2739+ WriteLn(F, ' class function ClassName: string; reintroduce;');
2740+ WriteLn(F, ' class function ClassNameIs(const Name: string): Boolean; reintroduce;');
2741+ WriteLn(F, ' protected');
2742+ WriteLn(F, ' class procedure ClassParent; reintroduce;');
2743+ WriteLn(F, ' class procedure ClassInfo; reintroduce;');
2744+ WriteLn(F, ' class procedure InstanceSize; reintroduce;');
2745+ WriteLn(F, ' class procedure InheritsFrom; reintroduce;');
2746+ WriteLn(F, ' class procedure MethodAddress; reintroduce;');
2747+ WriteLn(F, ' class procedure MethodName; reintroduce;');
2748+ WriteLn(F, ' procedure FieldAddress; reintroduce;');
2749+ WriteLn(F, ' procedure GetInterface; reintroduce;');
2750+ WriteLn(F, ' class procedure GetInterfaceEntry; reintroduce;');
2751+ WriteLn(F, ' class procedure GetInterfaceTable; reintroduce;');
2752+ WriteLn(F, ' procedure SafeCallException; reintroduce;');
2753+ WriteLn(F, ' public');
2754+ WriteLn(F, ' procedure AfterConstruction; reintroduce;');
2755+ WriteLn(F, ' procedure BeforeDestruction; reintroduce;');
2756+ WriteLn(F, ' protected');
2757+ WriteLn(F, ' procedure Dispatch; reintroduce;');
2758+ WriteLn(F, ' procedure DefaultHandler; reintroduce;');
2759+ WriteLn(F, ' class procedure NewInstance; reintroduce;');
2760+ WriteLn(F, ' public');
2761+ WriteLn(F, ' procedure FreeInstance; reintroduce;');
2762+ WriteLn(F, ' procedure Destroy; reintroduce;');
27012763 WriteLn(F, ' protected');
27022764 WriteLn(F, ' function GetKind: TCKind;');
27032765 WriteLn(F, ' function GetParamCount: LongInt;');
@@ -2736,7 +2798,6 @@
27362798 WriteLn(F, ' class function TC_FullInterfaceDescription: TypeCode;');
27372799 WriteLn(F, ' function Equal(y: TypeCode): CORBABoolean;');
27382800 WriteLn(F, ' function Copy: TypeCode;');
2739- WriteLn(F, ' procedure Free;');
27402801 WriteLn(F, ' procedure Print;');
27412802 WriteLn(F, ' class function Create(tag: TCKind): TypeCode; overload;');
27422803 WriteLn(F, ' class function Create(tag: TCKind; const Arguments: array of const): TypeCode; overload;');
@@ -3025,14 +3086,129 @@
30253086 WriteLn(F, 'var');
30263087 WriteLn(F, ' DLLLoad_CriticalSection : Windows.TRTLCriticalSection;');
30273088 WriteLn(F);
3028- WriteLn(F, 'procedure SOMObjectBase.Create;');
3089+ WriteLn(F, 'class procedure SOMObjectBase.Create;');
30293090 WriteLn(F, 'begin');
30303091 WriteLn(F, ' { hide this method }');
30313092 WriteLn(F, 'end;');
30323093 WriteLn(F);
3094+ WriteLn(F, 'procedure SOMObjectBase.Free;');
3095+ WriteLn(F, 'begin');
3096+ WriteLn(F, ' if Assigned(Self) then SOMObject(Self).somFree;');
3097+ WriteLn(F, 'end;');
3098+ WriteLn(F);
3099+ WriteLn(F, 'class procedure SOMObjectBase.InitInstance;');
3100+ WriteLn(F, 'begin');
3101+ WriteLn(F, ' { hide this method }');
3102+ WriteLn(F, 'end;');
3103+ WriteLn(F);
3104+ WriteLn(F, 'procedure SOMObjectBase.CleanupInstance;');
3105+ WriteLn(F, 'begin');
3106+ WriteLn(F, ' { in SOM, everything is being cleaned up by destructors }');
3107+ WriteLn(F, 'end;');
3108+ WriteLn(F);
3109+ WriteLn(F, 'function SOMObjectBase.ClassType: SOMClass;');
3110+ WriteLn(F, 'begin');
3111+ WriteLn(F, ' Result := SOMObject(Self).somGetClass;');
3112+ WriteLn(F, 'end;');
3113+ WriteLn(F);
3114+ WriteLn(F, 'class procedure SOMObjectBase.ClassName;');
3115+ WriteLn(F, 'begin');
3116+ WriteLn(F, ' { hide this method }');
3117+ WriteLn(F, 'end;');
3118+ WriteLn(F);
3119+ WriteLn(F, 'class procedure SOMObjectBase.ClassNameIs;');
3120+ WriteLn(F, 'begin');
3121+ WriteLn(F, ' { hide this method }');
3122+ WriteLn(F, 'end;');
3123+ WriteLn(F);
3124+ WriteLn(F, 'class procedure SOMObjectBase.ClassParent;');
3125+ WriteLn(F, 'begin');
3126+ WriteLn(F, ' { hide this method }');
3127+ WriteLn(F, 'end;');
3128+ WriteLn(F);
3129+ WriteLn(F, 'class procedure SOMObjectBase.ClassInfo;');
3130+ WriteLn(F, 'begin');
3131+ WriteLn(F, ' { hide this method }');
3132+ WriteLn(F, 'end;');
3133+ WriteLn(F);
3134+ WriteLn(F, 'class procedure SOMObjectBase.InstanceSize;');
3135+ WriteLn(F, 'begin');
3136+ WriteLn(F, ' { hide this method }');
3137+ WriteLn(F, 'end;');
3138+ WriteLn(F);
3139+ WriteLn(F, 'class procedure SOMObjectBase.InheritsFrom;');
3140+ WriteLn(F, 'begin');
3141+ WriteLn(F, ' { hide this method }');
3142+ WriteLn(F, 'end;');
3143+ WriteLn(F);
3144+ WriteLn(F, 'class procedure SOMObjectBase.MethodAddress;');
3145+ WriteLn(F, 'begin');
3146+ WriteLn(F, ' { hide this method }');
3147+ WriteLn(F, 'end;');
3148+ WriteLn(F);
3149+ WriteLn(F, 'class procedure SOMObjectBase.MethodName;');
3150+ WriteLn(F, 'begin');
3151+ WriteLn(F, ' { hide this method }');
3152+ WriteLn(F, 'end;');
3153+ WriteLn(F);
3154+ WriteLn(F, 'procedure SOMObjectBase.FieldAddress;');
3155+ WriteLn(F, 'begin');
3156+ WriteLn(F, ' { hide this method }');
3157+ WriteLn(F, 'end;');
3158+ WriteLn(F);
3159+ WriteLn(F, 'procedure SOMObjectBase.GetInterface;');
3160+ WriteLn(F, 'begin');
3161+ WriteLn(F, ' { hide this method }');
3162+ WriteLn(F, 'end;');
3163+ WriteLn(F);
3164+ WriteLn(F, 'class procedure SOMObjectBase.GetInterfaceEntry;');
3165+ WriteLn(F, 'begin');
3166+ WriteLn(F, ' { hide this method }');
3167+ WriteLn(F, 'end;');
3168+ WriteLn(F);
3169+ WriteLn(F, 'class procedure SOMObjectBase.GetInterfaceTable;');
3170+ WriteLn(F, 'begin');
3171+ WriteLn(F, ' { hide this method }');
3172+ WriteLn(F, 'end;');
3173+ WriteLn(F);
3174+ WriteLn(F, 'procedure SOMObjectBase.SafeCallException;');
3175+ WriteLn(F, 'begin');
3176+ WriteLn(F, ' { hide this method }');
3177+ WriteLn(F, 'end;');
3178+ WriteLn(F);
3179+ WriteLn(F, 'procedure SOMObjectBase.AfterConstruction;');
3180+ WriteLn(F, 'begin');
3181+ WriteLn(F, ' { in SOM that is being done by cooperative metaclass }');
3182+ WriteLn(F, 'end;');
3183+ WriteLn(F);
3184+ WriteLn(F, 'procedure SOMObjectBase.BeforeDestruction;');
3185+ WriteLn(F, 'begin');
3186+ WriteLn(F, ' { in SOM that is being done by cooperative metaclass }');
3187+ WriteLn(F, 'end;');
3188+ WriteLn(F);
3189+ WriteLn(F, 'procedure SOMObjectBase.Dispatch;');
3190+ WriteLn(F, 'begin');
3191+ WriteLn(F, ' { hide this method }');
3192+ WriteLn(F, 'end;');
3193+ WriteLn(F);
3194+ WriteLn(F, 'procedure SOMObjectBase.DefaultHandler;');
3195+ WriteLn(F, 'begin');
3196+ WriteLn(F, ' { hide this method }');
3197+ WriteLn(F, 'end;');
3198+ WriteLn(F);
3199+ WriteLn(F, 'class procedure SOMObjectBase.NewInstance;');
3200+ WriteLn(F, 'begin');
3201+ WriteLn(F, ' { hide this method }');
3202+ WriteLn(F, 'end;');
3203+ WriteLn(F);
3204+ WriteLn(F, 'procedure SOMObjectBase.FreeInstance;');
3205+ WriteLn(F, 'begin');
3206+ WriteLn(F, ' SOMObject(Self).somGetClass.somDeallocate(PAnsiChar(Pointer(Self)));');
3207+ WriteLn(F, 'end;');
3208+ WriteLn(F);
30333209 WriteLn(F, 'procedure SOMObjectBase.Destroy;');
30343210 WriteLn(F, 'begin');
3035- WriteLn(F, ' { hide this method }');
3211+ WriteLn(F, ' SOMObject(Self).somFree;');
30363212 WriteLn(F, 'end;');
30373213 WriteLn(F);
30383214 WriteLn(F, 'function SOMObjectBase.As_SOMObject; {$IFDEF DELPHI_HAS_INLINE} inline; {$ENDIF}');
@@ -3060,9 +3236,133 @@
30603236 WriteLn(F, 'end;');
30613237 FDLLs.Add('somtc.dll');
30623238 WriteLn(F);
3239+ WriteLn(F, 'procedure TypeCode.Free;');
3240+ WriteLn(F, 'begin');
3241+ WriteLn(F, ' if Assigned(Self) then');
3242+ WriteLn(F, ' begin');
3243+ WriteLn(F, ' FreeInstance;');
3244+ WriteLn(F, ' end;');
3245+ WriteLn(F, 'end;');
3246+ WriteLn(F);
3247+ WriteLn(F, 'class procedure TypeCode.InitInstance;');
3248+ WriteLn(F, 'begin');
3249+ WriteLn(F, ' { hide this method }');
3250+ WriteLn(F, 'end;');
3251+ WriteLn(F);
3252+ WriteLn(F, 'procedure TypeCode.CleanupInstance;');
3253+ WriteLn(F, 'begin');
3254+ WriteLn(F, ' { TypeCode_free does everything at the same time, so no separate Cleanup }');
3255+ WriteLn(F, 'end;');
3256+ WriteLn(F);
3257+ WriteLn(F, 'procedure TypeCode.ClassType;');
3258+ WriteLn(F, 'begin');
3259+ WriteLn(F, ' { hide this method }');
3260+ WriteLn(F, 'end;');
3261+ WriteLn(F);
3262+ WriteLn(F, 'class function TypeCode.ClassName: string;');
3263+ WriteLn(F, 'begin');
3264+ WriteLn(F, ' Result := ''TypeCode'';');
3265+ WriteLn(F, 'end;');
3266+ WriteLn(F);
3267+ WriteLn(F, 'class function TypeCode.ClassNameIs(const Name: string): Boolean;');
3268+ WriteLn(F, 'begin');
3269+ WriteLn(F, ' Result := Name = ''TypeCode'';');
3270+ WriteLn(F, 'end;');
3271+ WriteLn(F);
3272+ WriteLn(F, 'class procedure TypeCode.ClassParent;');
3273+ WriteLn(F, 'begin');
3274+ WriteLn(F, ' { hide this method }');
3275+ WriteLn(F, 'end;');
3276+ WriteLn(F);
3277+ WriteLn(F, 'class procedure TypeCode.ClassInfo;');
3278+ WriteLn(F, 'begin');
3279+ WriteLn(F, ' { hide this method }');
3280+ WriteLn(F, 'end;');
3281+ WriteLn(F);
3282+ WriteLn(F, 'class procedure TypeCode.InstanceSize;');
3283+ WriteLn(F, 'begin');
3284+ WriteLn(F, ' { hide this method }');
3285+ WriteLn(F, 'end;');
3286+ WriteLn(F);
3287+ WriteLn(F, 'class procedure TypeCode.InheritsFrom;');
3288+ WriteLn(F, 'begin');
3289+ WriteLn(F, ' { hide this method }');
3290+ WriteLn(F, 'end;');
3291+ WriteLn(F);
3292+ WriteLn(F, 'class procedure TypeCode.MethodAddress;');
3293+ WriteLn(F, 'begin');
3294+ WriteLn(F, ' { hide this method }');
3295+ WriteLn(F, 'end;');
3296+ WriteLn(F);
3297+ WriteLn(F, 'class procedure TypeCode.MethodName;');
3298+ WriteLn(F, 'begin');
3299+ WriteLn(F, ' { hide this method }');
3300+ WriteLn(F, 'end;');
3301+ WriteLn(F);
3302+ WriteLn(F, 'procedure TypeCode.FieldAddress;');
3303+ WriteLn(F, 'begin');
3304+ WriteLn(F, ' { hide this method }');
3305+ WriteLn(F, 'end;');
3306+ WriteLn(F);
3307+ WriteLn(F, 'procedure TypeCode.GetInterface;');
3308+ WriteLn(F, 'begin');
3309+ WriteLn(F, ' { hide this method }');
3310+ WriteLn(F, 'end;');
3311+ WriteLn(F);
3312+ WriteLn(F, 'class procedure TypeCode.GetInterfaceEntry;');
3313+ WriteLn(F, 'begin');
3314+ WriteLn(F, ' { hide this method }');
3315+ WriteLn(F, 'end;');
3316+ WriteLn(F);
3317+ WriteLn(F, 'class procedure TypeCode.GetInterfaceTable;');
3318+ WriteLn(F, 'begin');
3319+ WriteLn(F, ' { hide this method }');
3320+ WriteLn(F, 'end;');
3321+ WriteLn(F);
3322+ WriteLn(F, 'procedure TypeCode.SafeCallException;');
3323+ WriteLn(F, 'begin');
3324+ WriteLn(F, ' { hide this method }');
3325+ WriteLn(F, 'end;');
3326+ WriteLn(F);
3327+ WriteLn(F, 'procedure TypeCode.AfterConstruction;');
3328+ WriteLn(F, 'begin');
3329+ WriteLn(F, ' { nothing to do }');
3330+ WriteLn(F, 'end;');
3331+ WriteLn(F);
3332+ WriteLn(F, 'procedure TypeCode.BeforeDestruction;');
3333+ WriteLn(F, 'begin');
3334+ WriteLn(F, ' { nothing to do }');
3335+ WriteLn(F, 'end;');
3336+ WriteLn(F);
3337+ WriteLn(F, 'procedure TypeCode.Dispatch;');
3338+ WriteLn(F, 'begin');
3339+ WriteLn(F, ' { hide this method }');
3340+ WriteLn(F, 'end;');
3341+ WriteLn(F);
3342+ WriteLn(F, 'procedure TypeCode.DefaultHandler;');
3343+ WriteLn(F, 'begin');
3344+ WriteLn(F, ' { hide this method }');
3345+ WriteLn(F, 'end;');
3346+ WriteLn(F);
3347+ WriteLn(F, 'class procedure TypeCode.NewInstance;');
3348+ WriteLn(F, 'begin');
3349+ WriteLn(F, ' { hide this method }');
3350+ WriteLn(F, 'end;');
3351+ WriteLn(F);
3352+ WriteLn(F, 'procedure TypeCode_free(t: TypeCode; ev: PEnvironment); stdcall; external SOMTC_DLL_Name name ''tcFree'';');
3353+ WriteLn(F);
3354+ WriteLn(F, 'procedure TypeCode.FreeInstance;');
3355+ WriteLn(F, 'var');
3356+ WriteLn(F, ' LocalEnv: Environment;');
3357+ WriteLn(F, 'begin');
3358+ WriteLn(F, ' SOM_InitEnvironment(@LocalEnv);');
3359+ WriteLn(F, ' TypeCode_free(Self, @LocalEnv);');
3360+ WriteLn(F, ' SOM_UninitEnvironmentOrRaise(@LocalEnv);');
3361+ WriteLn(F, 'end;');
3362+ WriteLn(F);
30633363 WriteLn(F, 'procedure TypeCode.Destroy;');
30643364 WriteLn(F, 'begin');
3065- WriteLn(F, ' { hide this method }'); // TODO free?
3365+ WriteLn(F, ' FreeInstance;');
30663366 WriteLn(F, 'end;');
30673367 WriteLn(F);
30683368 WriteLn(F, 'function TypeCode_kind(t: TypeCode; ev: PEnvironment): TCKind; stdcall; external SOMTC_DLL_Name name ''tcKind'';');
@@ -3545,17 +3845,6 @@
35453845 WriteLn(F, ' SOM_UninitEnvironmentOrRaise(@LocalEnv);');
35463846 WriteLn(F, 'end;');
35473847 WriteLn(F);
3548- WriteLn(F, 'procedure TypeCode_free(t: TypeCode; ev: PEnvironment); stdcall; external SOMTC_DLL_Name name ''tcFree'';');
3549- WriteLn(F);
3550- WriteLn(F, 'procedure TypeCode.Free;');
3551- WriteLn(F, 'var');
3552- WriteLn(F, ' LocalEnv: Environment;');
3553- WriteLn(F, 'begin');
3554- WriteLn(F, ' SOM_InitEnvironment(@LocalEnv);');
3555- WriteLn(F, ' TypeCode_free(Self, @LocalEnv);');
3556- WriteLn(F, ' SOM_UninitEnvironmentOrRaise(@LocalEnv);');
3557- WriteLn(F, 'end;');
3558- WriteLn(F);
35593848 WriteLn(F, 'procedure TypeCode_print(t: TypeCode; ev: PEnvironment); stdcall; external SOMTC_DLL_Name name ''tcPrint'';');
35603849 WriteLn(F);
35613850 WriteLn(F, 'procedure TypeCode.Print;');
@@ -4045,7 +4334,6 @@
40454334
40464335 begin
40474336 try
4048- WriteLn('Testing SOMObject v', SOM_MajorVersion, '.', SOM_MinorVersion);
40494337 SOM_MainProgram;
40504338 TestSOM_IR;
40514339 except
diff -r c34e53e000f0 -r bfeeb6eebca5 TODO.txt
--- a/TODO.txt Sun Oct 30 00:46:17 2016 +0700
+++ b/TODO.txt Sun Oct 30 03:08:16 2016 +0700
@@ -1,4 +1,4 @@
1-InstanceSize, InitInstance and convert Create from class function to constructor
1+InstanceSize, InitInstance and others (conversion of Create to constructor is impossible due to AfterConstruction)
22 implement Clone
33 map exceptions to proper types
44 array of const to vabuf and va_list in somDispatch
Show on old repository browser