Add is/as for interface types with _ImplementsInterface/_GetItab dispatch

Extend BlaiseTypeInfo with an impllist field (NULL-terminated {ti,itab} pairs) so the runtime can walk a class's interface set. Add _ImplementsInterface and _GetItab to blaise_exc.c for the 'is IFoo' and 'F := T as IFoo' operators respectively. Compiler changes: - uAST: ResolvedTargetType field on TIsExpr - uSemantic: accept tyInterface on RHS of is/as; set ResolvedTargetType - uCodeGenQBE: EmitIsExpr dispatches to _ImplementsInterface for interface targets; EmitAssignment handles F := T as IFoo via _GetItab + branch - EmitTypeInfoDefs: extend to 2-field layout {parent, impllist} - EmitInterfaceDefs: emit per-class impllist data blocks - uSymbolTable: register IInterface as built-in interface type 10 new tests in cp.test.interfaces; 2 existing typeinfo tests updated for new 2-field format. 494 tests, 0 failures.
2026-04-21 21:25:49 +01:00 · 2026-04-21 21:25:49 +01:00 · 3365558265
parent c371272811
commit 3365558265
7 changed files with 350 additions and 41 deletions
--- a/compiler/src/main/pascal/uAST.pas
+++ b/compiler/src/main/pascal/uAST.pas
@ -54,8 +54,9 @@ type

  TIsExpr = class(TASTExpr)
  public
-    Obj:      TASTExpr;  { owned — left-hand side; must be class instance }
-    TypeName: string;    { right-hand side type name; resolved by uSemantic }
+    Obj:                TASTExpr;   { owned — left-hand side; must be class instance }
+    TypeName:           string;     { right-hand side type name; resolved by uSemantic }
+    ResolvedTargetType: TTypeDesc;  { set by uSemantic — class or interface descriptor }
    destructor Destroy; override;
  end;

--- a/compiler/src/main/pascal/uCodeGenQBE.pas
+++ b/compiler/src/main/pascal/uCodeGenQBE.pas
@ -549,15 +549,50 @@ end;
 procedure TCodeGenQBE.EmitAssignment(AAssign: TAssignment);
 var
  ValTemp, OldTemp, QType, StoreInstr, PtrTemp: string;
-  IntfDesc: TInterfaceTypeDesc;
-  ClassRT:  TRecordTypeDesc;
-  ItabName: string;
+  IntfDesc:  TInterfaceTypeDesc;
+  ClassRT:   TRecordTypeDesc;
+  ItabName:  string;
+  AE:        TAsExpr;
+  ObjTemp:   string;
+  ItabTemp:  string;
+  CheckTemp: string;
+  LblOk:     string;
+  LblFail:   string;
+  LblEnd:    string;
 begin
  if AAssign.Expr.ResolvedType = nil then
    raise ECodeGenError.CreateFmt(
      'Expression in assignment to ''%s'' has no resolved type', [AAssign.Name]);

-  { Interface assignment: store obj pointer + itab pointer }
+  { Interface as-cast: F := T as IFoo — use _GetItab for runtime itab lookup }
+  if (AAssign.ResolvedLhsType <> nil) and
+     (AAssign.ResolvedLhsType.Kind = tyInterface) and
+     (AAssign.Expr is TAsExpr) and
+     (AAssign.Expr.ResolvedType.Kind = tyInterface) then
+  begin
+    AE        := TAsExpr(AAssign.Expr);
+    IntfDesc  := TInterfaceTypeDesc(AAssign.ResolvedLhsType);
+    ObjTemp   := EmitExpr(AE.Obj);
+    ItabTemp  := AllocTemp;
+    EmitLine(Format('  %s =l call $_GetItab(l %s, l $typeinfo_%s)',
+      [ItabTemp, ObjTemp, AE.TypeName]));
+    CheckTemp := AllocTemp;
+    LblOk   := AllocLabel('as_ok');
+    LblFail := AllocLabel('as_fail');
+    LblEnd  := AllocLabel('as_end');
+    EmitLine(Format('  %s =w cnel %s, 0', [CheckTemp, ItabTemp]));
+    EmitLine(Format('  jnz %s, @%s, @%s', [CheckTemp, LblOk, LblFail]));
+    EmitLine('@' + LblFail);
+    EmitLine('  call $_Raise_InvalidCast()');
+    EmitLine(Format('  jmp @%s', [LblEnd]));
+    EmitLine('@' + LblOk);
+    EmitLine(Format('  storel %s, %%_var_%s_obj',  [ObjTemp, AAssign.Name]));
+    EmitLine(Format('  storel %s, %%_var_%s_itab', [ItabTemp, AAssign.Name]));
+    EmitLine('@' + LblEnd);
+    Exit;
+  end;
+
+  { Interface direct assignment: F := T where T is a class implementing the interface }
  if (AAssign.ResolvedLhsType <> nil) and
     (AAssign.ResolvedLhsType.Kind = tyInterface) and
     (AAssign.Expr.ResolvedType.Kind = tyClass) then
@ -844,13 +879,16 @@ end;

 procedure TCodeGenQBE.EmitTypeInfoDefs(AProg: TProgram);
 { Emit one $typeinfo_T data item per class type.
-  Layout: { l parent_typeinfo_or_zero }
-  TypeInfo is at vtable slot 0; _IsInstance walks parent chain via this ptr. }
+  Layout: { l parent_typeinfo_or_zero, l impllist_or_zero }
+  TypeInfo is at vtable slot 0; _IsInstance walks parent chain.
+  impllist is NULL-terminated array of {typeinfo_intf, itab} pairs for _ImplementsInterface. }
 var
-  I:     Integer;
-  TD:    TTypeDecl;
-  TDesc: TTypeDesc;
-  RT:    TRecordTypeDesc;
+  I:         Integer;
+  TD:        TTypeDecl;
+  TDesc:     TTypeDesc;
+  RT:        TRecordTypeDesc;
+  ParentStr: string;
+  ImplStr:   string;
 begin
  for I := 0 to AProg.Block.TypeDecls.Count - 1 do
  begin
@ -860,10 +898,15 @@ begin
    if (TDesc = nil) or not (TDesc is TRecordTypeDesc) then Continue;
    RT := TRecordTypeDesc(TDesc);
    if RT.Parent <> nil then
-      EmitLine('data $typeinfo_' + TD.Name +
-               ' = { l $typeinfo_' + RT.Parent.Name + ' }')
+      ParentStr := '$typeinfo_' + RT.Parent.Name
    else
-      EmitLine('data $typeinfo_' + TD.Name + ' = { l 0 }');
+      ParentStr := '0';
+    if RT.ImplementsCount > 0 then
+      ImplStr := '$impllist_' + TD.Name
+    else
+      ImplStr := '0';
+    EmitLine('data $typeinfo_' + TD.Name +
+             ' = { l ' + ParentStr + ', l ' + ImplStr + ' }');
  end;
  EmitLine('');
 end;
@ -901,18 +944,20 @@ begin
 end;

 procedure TCodeGenQBE.EmitInterfaceDefs(AProg: TProgram);
-{ Emit typeinfo blocks for interfaces and itab blocks for class-interface pairs.
-  Interface typeinfo: data $typeinfo_IFoo = { l 0 }  (address IS the identity)
+{ Emit typeinfo blocks for interfaces and itab/impllist blocks for class-interface pairs.
+  Interface typeinfo: data $typeinfo_IFoo = { l 0 }  (address IS the identity token)
  Itab: data $itab_TFoo_IFoo = { l $TFoo_DoIt, l $TFoo_GetVal }
-  Methods appear in declaration order (itab slot N = interface method N). }
+  Impllist: data $impllist_TFoo = { l $typeinfo_IFoo, l $itab_TFoo_IFoo, l 0 }
+  Methods in declaration order; impllist is NULL-terminated {ti, itab} pair array. }
 var
-  I, J, K:  Integer;
-  TD:       TTypeDecl;
-  TDesc:    TTypeDesc;
-  IntfDesc: TInterfaceTypeDesc;
-  ClassRT:  TRecordTypeDesc;
-  ItabLine: string;
-  MethName: string;
+  I, J, K:     Integer;
+  TD:          TTypeDecl;
+  TDesc:       TTypeDesc;
+  IntfDesc:    TInterfaceTypeDesc;
+  ClassRT:     TRecordTypeDesc;
+  ItabLine:    string;
+  ImplLine:    string;
+  MethName:    string;
 begin
  { Typeinfo blocks for every interface }
  for I := 0 to AProg.Block.TypeDecls.Count - 1 do
@ -922,7 +967,7 @@ begin
    EmitLine('data $typeinfo_' + TD.Name + ' = { l 0 }');
  end;

-  { Itab blocks for each (class, interface) pair }
+  { Itab and impllist blocks for each implementing class }
  for I := 0 to AProg.Block.TypeDecls.Count - 1 do
  begin
    TD := TTypeDecl(AProg.Block.TypeDecls[I]);
@ -930,6 +975,9 @@ begin
    TDesc := AProg.SymbolTable.FindType(TD.Name);
    if (TDesc = nil) or not (TDesc is TRecordTypeDesc) then Continue;
    ClassRT := TRecordTypeDesc(TDesc);
+    if ClassRT.ImplementsCount = 0 then Continue;
+
+    { One itab per interface }
    for J := 0 to ClassRT.ImplementsCount - 1 do
    begin
      IntfDesc := ClassRT.ImplementsIntfAt(J);
@ -945,6 +993,21 @@ begin
      ItabLine := ItabLine + ' }';
      EmitLine(ItabLine);
    end;
+
+    { One impllist per class: NULL-terminated {typeinfo_intf, itab} pairs }
+    ImplLine := 'data $impllist_' + TD.Name + ' = {';
+    for J := 0 to ClassRT.ImplementsCount - 1 do
+    begin
+      IntfDesc := ClassRT.ImplementsIntfAt(J);
+      if J = 0 then
+        ImplLine := ImplLine + ' l $typeinfo_' + IntfDesc.Name +
+                               ', l $itab_' + TD.Name + '_' + IntfDesc.Name
+      else
+        ImplLine := ImplLine + ', l $typeinfo_' + IntfDesc.Name +
+                               ', l $itab_' + TD.Name + '_' + IntfDesc.Name;
+    end;
+    ImplLine := ImplLine + ', l 0 }';
+    EmitLine(ImplLine);
  end;
  EmitLine('');
 end;
@ -1415,8 +1478,13 @@ var
 begin
  ObjTemp := EmitExpr(AExpr.Obj);
  ResTemp := AllocTemp;
-  EmitLine(Format('  %s =w call $_IsInstance(l %s, l $typeinfo_%s)',
-    [ResTemp, ObjTemp, AExpr.TypeName]));
+  if (AExpr.ResolvedTargetType <> nil) and
+     (AExpr.ResolvedTargetType.Kind = tyInterface) then
+    EmitLine(Format('  %s =w call $_ImplementsInterface(l %s, l $typeinfo_%s)',
+      [ResTemp, ObjTemp, AExpr.TypeName]))
+  else
+    EmitLine(Format('  %s =w call $_IsInstance(l %s, l $typeinfo_%s)',
+      [ResTemp, ObjTemp, AExpr.TypeName]));
  Result := ResTemp;
 end;

--- a/compiler/src/main/pascal/uSemantic.pas
+++ b/compiler/src/main/pascal/uSemantic.pas
@ -1389,12 +1389,14 @@ begin
      AExpr.Line, AExpr.Col);

  TargetType := FTable.FindType(AExpr.TypeName);
-  if (TargetType = nil) or (TargetType.Kind <> tyClass) then
+  if (TargetType = nil) or
+     ((TargetType.Kind <> tyClass) and (TargetType.Kind <> tyInterface)) then
    SemanticError(
-      Format('''is'' requires a class type name on the right, got ''%s''',
+      Format('''is'' requires a class or interface type name on the right, got ''%s''',
        [AExpr.TypeName]),
      AExpr.Line, AExpr.Col);

+  AExpr.ResolvedTargetType := TargetType;
  Result := FTable.TypeBoolean;
 end;

@ -1411,9 +1413,10 @@ begin
      AExpr.Line, AExpr.Col);

  TargetType := FTable.FindType(AExpr.TypeName);
-  if (TargetType = nil) or (TargetType.Kind <> tyClass) then
+  if (TargetType = nil) or
+     ((TargetType.Kind <> tyClass) and (TargetType.Kind <> tyInterface)) then
    SemanticError(
-      Format('''as'' requires a class type name on the right, got ''%s''',
+      Format('''as'' requires a class or interface type name on the right, got ''%s''',
        [AExpr.TypeName]),
      AExpr.Line, AExpr.Col);

--- a/compiler/src/main/pascal/uSymbolTable.pas
+++ b/compiler/src/main/pascal/uSymbolTable.pas
@ -640,6 +640,9 @@ begin
  { TObject — root of the class hierarchy; no fields, no parent }
  Define(TSymbol.Create('TObject', skType, NewClassType('TObject')));

+  { IInterface — root of the interface hierarchy; no methods }
+  Define(TSymbol.Create('IInterface', skType, NewInterfaceType('IInterface')));
+
  { Built-in I/O procedures }
  Sym := TSymbol.Create('Write',   skProcedure, nil);
  Define(Sym);
--- a/compiler/src/test/pascal/cp.test.interfaces.pas
+++ b/compiler/src/test/pascal/cp.test.interfaces.pas
@ -34,6 +34,20 @@ type
    procedure TestSemantic_ClassImplements_OK;
    procedure TestSemantic_ClassImplements_MissingMethod_RaisesError;

+    { ------------------------------------------------------------------ }
+    { Semantic — is/as with interface types                                }
+    { ------------------------------------------------------------------ }
+    procedure TestSemantic_IsExpr_Interface_OK;
+    procedure TestSemantic_IsExpr_Interface_ResultIsBoolean;
+    procedure TestSemantic_AsExpr_Interface_OK;
+    procedure TestSemantic_AsExpr_Interface_ResultType;
+
+    { ------------------------------------------------------------------ }
+    { Semantic — IInterface built-in                                       }
+    { ------------------------------------------------------------------ }
+    procedure TestSemantic_IInterface_Registered;
+    procedure TestSemantic_IInterface_IsInterfaceKind;
+
    { ------------------------------------------------------------------ }
    { Code generation                                                      }
    { ------------------------------------------------------------------ }
@ -42,6 +56,10 @@ type
    procedure TestCodegen_Itab_ContainsMethodPointer;
    procedure TestCodegen_InterfaceVar_AllocsTwoSlots;
    procedure TestCodegen_InterfaceMethodCall_IndirectDispatch;
+    procedure TestCodegen_Typeinfo_ClassHasImpllistField;
+    procedure TestCodegen_Impllist_Emitted;
+    procedure TestCodegen_IsExpr_Interface_CallsImplementsInterface;
+    procedure TestCodegen_AsExpr_Interface_CallsGetItab;
  end;

 implementation
@ -131,6 +149,46 @@ const
    'begin'                                    + LineEnding +
    'end.';

+  SrcIsExprInterface =
+    'program P;'                               + LineEnding +
+    'type'                                     + LineEnding +
+    '  IFoo = interface'                       + LineEnding +
+    '    procedure DoIt;'                      + LineEnding +
+    '  end;'                                   + LineEnding +
+    '  TFoo = class(TObject, IFoo)'            + LineEnding +
+    '    procedure DoIt;'                      + LineEnding +
+    '  end;'                                   + LineEnding +
+    'procedure TFoo.DoIt;'                     + LineEnding +
+    'begin'                                    + LineEnding +
+    'end;'                                     + LineEnding +
+    'var'                                      + LineEnding +
+    '  T: TFoo;'                               + LineEnding +
+    '  R: Boolean;'                            + LineEnding +
+    'begin'                                    + LineEnding +
+    '  T := TFoo.Create;'                      + LineEnding +
+    '  R := T is IFoo'                         + LineEnding +
+    'end.';
+
+  SrcAsExprInterface =
+    'program P;'                               + LineEnding +
+    'type'                                     + LineEnding +
+    '  IFoo = interface'                       + LineEnding +
+    '    procedure DoIt;'                      + LineEnding +
+    '  end;'                                   + LineEnding +
+    '  TFoo = class(TObject, IFoo)'            + LineEnding +
+    '    procedure DoIt;'                      + LineEnding +
+    '  end;'                                   + LineEnding +
+    'procedure TFoo.DoIt;'                     + LineEnding +
+    'begin'                                    + LineEnding +
+    'end;'                                     + LineEnding +
+    'var'                                      + LineEnding +
+    '  T: TFoo;'                               + LineEnding +
+    '  F: IFoo;'                               + LineEnding +
+    'begin'                                    + LineEnding +
+    '  T := TFoo.Create;'                      + LineEnding +
+    '  F := T as IFoo'                         + LineEnding +
+    'end.';
+
  SrcInterfaceVar =
    'program P;'                               + LineEnding +
    'type'                                     + LineEnding +
@ -422,6 +480,133 @@ begin
  AssertTrue('indirect call via register', Pos('call %', IR) > 0);
 end;

+{ ------------------------------------------------------------------ }
+{ Semantic — is/as with interface types                                }
+{ ------------------------------------------------------------------ }
+
+procedure TInterfaceTests.TestSemantic_IsExpr_Interface_OK;
+begin
+  AnalyseSrc(SrcIsExprInterface).Free;
+end;
+
+procedure TInterfaceTests.TestSemantic_IsExpr_Interface_ResultIsBoolean;
+var
+  Prog: TProgram;
+  IE:   TIsExpr;
+begin
+  Prog := AnalyseSrc(SrcIsExprInterface);
+  try
+    { Stmts[0] = T := TFoo.Create; Stmts[1] = R := T is IFoo }
+    IE := TIsExpr(TAssignment(Prog.Block.Stmts[1]).Expr);
+    AssertNotNull('resolved type', IE.ResolvedType);
+    AssertEquals('result is Boolean', Ord(tyBoolean), Ord(IE.ResolvedType.Kind));
+  finally
+    Prog.Free;
+  end;
+end;
+
+procedure TInterfaceTests.TestSemantic_AsExpr_Interface_OK;
+begin
+  AnalyseSrc(SrcAsExprInterface).Free;
+end;
+
+procedure TInterfaceTests.TestSemantic_AsExpr_Interface_ResultType;
+var
+  Prog: TProgram;
+  AE:   TAsExpr;
+begin
+  Prog := AnalyseSrc(SrcAsExprInterface);
+  try
+    { Stmts[0] = T := TFoo.Create; Stmts[1] = F := T as IFoo }
+    AE := TAsExpr(TAssignment(Prog.Block.Stmts[1]).Expr);
+    AssertNotNull('resolved type', AE.ResolvedType);
+    AssertEquals('result kind is tyInterface', Ord(tyInterface), Ord(AE.ResolvedType.Kind));
+    AssertEquals('result type name is IFoo', 'IFoo', AE.ResolvedType.Name);
+  finally
+    Prog.Free;
+  end;
+end;
+
+{ ------------------------------------------------------------------ }
+{ Semantic — IInterface built-in                                       }
+{ ------------------------------------------------------------------ }
+
+procedure TInterfaceTests.TestSemantic_IInterface_Registered;
+var
+  Prog: TProgram;
+  Sym:  TSymbol;
+begin
+  Prog := AnalyseSrc('program P; begin end.');
+  try
+    Sym := Prog.SymbolTable.Lookup('IInterface');
+    AssertNotNull('IInterface symbol exists', Sym);
+    AssertEquals('IInterface is skType', Ord(skType), Ord(Sym.Kind));
+  finally
+    Prog.Free;
+  end;
+end;
+
+procedure TInterfaceTests.TestSemantic_IInterface_IsInterfaceKind;
+var
+  Prog: TProgram;
+  TD:   TTypeDesc;
+begin
+  Prog := AnalyseSrc('program P; begin end.');
+  try
+    TD := Prog.SymbolTable.FindType('IInterface');
+    AssertNotNull('IInterface type exists', TD);
+    AssertEquals('kind is tyInterface', Ord(tyInterface), Ord(TD.Kind));
+  finally
+    Prog.Free;
+  end;
+end;
+
+{ ------------------------------------------------------------------ }
+{ Codegen — impllist and extended typeinfo                             }
+{ ------------------------------------------------------------------ }
+
+procedure TInterfaceTests.TestCodegen_Typeinfo_ClassHasImpllistField;
+var
+  IR: string;
+begin
+  IR := GenIR(SrcClassImplements);
+  { Class with implements must have 2-field typeinfo: { l parent, l impllist } }
+  AssertTrue('TFoo typeinfo has impllist field',
+    Pos('$typeinfo_TFoo = { l $typeinfo_TObject, l $impllist_TFoo }', IR) > 0);
+end;
+
+procedure TInterfaceTests.TestCodegen_Impllist_Emitted;
+var
+  IR: string;
+begin
+  IR := GenIR(SrcClassImplements);
+  AssertTrue('impllist_TFoo emitted', Pos('$impllist_TFoo', IR) > 0);
+  { Impllist contains typeinfo_IFoo and itab_TFoo_IFoo pointers }
+  AssertTrue('impllist references typeinfo_IFoo',
+    PosEx('$typeinfo_IFoo', IR,
+          Pos('$impllist_TFoo', IR)) > 0);
+  AssertTrue('impllist references itab_TFoo_IFoo',
+    PosEx('$itab_TFoo_IFoo', IR,
+          Pos('$impllist_TFoo', IR)) > 0);
+end;
+
+procedure TInterfaceTests.TestCodegen_IsExpr_Interface_CallsImplementsInterface;
+var
+  IR: string;
+begin
+  IR := GenIR(SrcIsExprInterface);
+  AssertTrue('is IFoo calls _ImplementsInterface',
+    Pos('call $_ImplementsInterface', IR) > 0);
+end;
+
+procedure TInterfaceTests.TestCodegen_AsExpr_Interface_CallsGetItab;
+var
+  IR: string;
+begin
+  IR := GenIR(SrcAsExprInterface);
+  AssertTrue('as IFoo calls _GetItab', Pos('call $_GetItab', IR) > 0);
+end;
+
 initialization
  RegisterTest(TInterfaceTests);

--- a/compiler/src/test/pascal/cp.test.typetests.pas
+++ b/compiler/src/test/pascal/cp.test.typetests.pas
@ -320,19 +320,19 @@ end;
 procedure TTypeTestTests.TestCodegen_TypeInfo_ParentPtr_IsZero_ForRoot;
 var IR: string;
 begin
-  { Root class (no parent) must have parent pointer = 0 }
+  { Root class (no parent) must have parent pointer = 0; second field is impllist = 0 }
  IR := GenIR(SrcBase);
  AssertTrue('root typeinfo has zero parent ptr',
-    Pos('$typeinfo_TAnimal = { l 0 }', IR) > 0);
+    Pos('$typeinfo_TAnimal = { l 0, l 0 }', IR) > 0);
 end;

 procedure TTypeTestTests.TestCodegen_TypeInfo_ParentPtr_ForDerived;
 var IR: string;
 begin
-  { Derived class typeinfo must reference parent typeinfo }
+  { Derived class typeinfo must reference parent typeinfo; impllist = 0 (no interfaces) }
  IR := GenIR(SrcInherit);
  AssertTrue('derived typeinfo refs parent',
-    Pos('$typeinfo_TDog = { l $typeinfo_TAnimal }', IR) > 0);
+    Pos('$typeinfo_TDog = { l $typeinfo_TAnimal, l 0 }', IR) > 0);
 end;

 procedure TTypeTestTests.TestCodegen_Vtable_StartsWithTypeInfo;
--- a/rtl/src/main/c/blaise_exc.c
+++ b/rtl/src/main/c/blaise_exc.c
@ -83,15 +83,18 @@ void _Reraise(void* exc) {
 * ----------------------------------------------------------------------- */

 /*
- * BlaiseTypeInfo — one per class, stored as vtable slot 0.
- * parent = pointer to parent class TypeInfo, or NULL for root classes.
+ * BlaiseTypeInfo — one per class/interface, stored as vtable slot 0.
+ * parent   = pointer to parent class TypeInfo, or NULL for root classes.
+ * impllist = NULL-terminated array of {typeinfo_intf*, itab*} pairs, or NULL
+ *            if the class implements no interfaces.
 */
 typedef struct BlaiseTypeInfo {
    const struct BlaiseTypeInfo* parent;
+    const void**                 impllist;
 } BlaiseTypeInfo;

 /*
- * _IsInstance — runtime 'is' check.
+ * _IsInstance — runtime 'is' check for class inheritance.
 * Walks the TypeInfo parent chain from the object's own TypeInfo upward.
 * Returns 1 if the object is an instance of target (or a subclass), else 0.
 * obj must be non-nil and point to an instance whose first field is the vptr.
@ -109,11 +112,57 @@ int _IsInstance(void* obj, const BlaiseTypeInfo* target) {
    return 0;
 }

+/*
+ * _ImplementsInterface — runtime 'is' check for interface membership.
+ * Walks the class TypeInfo chain; at each level searches the impllist for
+ * a matching interface TypeInfo pointer.
+ * Returns 1 if the object's class (or any ancestor) implements the interface.
+ */
+int _ImplementsInterface(void* obj, const BlaiseTypeInfo* intf_ti) {
+    const BlaiseTypeInfo* ti;
+    const void**          impl;
+    void**                vtable;
+    if (!obj || !intf_ti) return 0;
+    vtable = *(void***)obj;
+    ti     = (const BlaiseTypeInfo*)vtable[0];
+    while (ti) {
+        impl = ti->impllist;
+        while (impl && *impl) {
+            if ((const BlaiseTypeInfo*)(*impl) == intf_ti) return 1;
+            impl += 2;  /* each entry is {typeinfo*, itab*} — skip both */
+        }
+        ti = ti->parent;
+    }
+    return 0;
+}
+
+/*
+ * _GetItab — return the itab pointer for the given object/interface pair.
+ * Walks the class TypeInfo chain searching the impllist for a matching
+ * interface TypeInfo pointer; returns the associated itab on match.
+ * Returns NULL if the object's class does not implement the interface.
+ */
+const void* _GetItab(void* obj, const BlaiseTypeInfo* intf_ti) {
+    const BlaiseTypeInfo* ti;
+    const void**          impl;
+    void**                vtable;
+    if (!obj || !intf_ti) return 0;
+    vtable = *(void***)obj;
+    ti     = (const BlaiseTypeInfo*)vtable[0];
+    while (ti) {
+        impl = ti->impllist;
+        while (impl && *impl) {
+            if ((const BlaiseTypeInfo*)(*impl) == intf_ti) return *(impl + 1);
+            impl += 2;
+        }
+        ti = ti->parent;
+    }
+    return 0;
+}
+
 /*
 * _Raise_InvalidCast — raised by the 'as' operator when the type check fails.
- * Phase 2: aborts with a message. Phase 3 will raise EInvalidCast.
 */
 void _Raise_InvalidCast(void) {
-    /* TODO Phase 3: create EInvalidCast object and call _Raise */
    abort();
 }