Difference between revisions of "Trinity in Trouble"

From Freepascal Amiga wiki
Jump to navigation Jump to search
(→‎List of issues: list type PPObject_)
(→‎Hardening trinity: modified introduction and linked to unit trinity in Magorium's github account.)
Line 104: Line 104:
 
== Hardening trinity ==
 
== Hardening trinity ==
  
−
In order to circumvent some of the inconsistencies and incompatibilities, i needed a solution without tempering with the RTL and/or support units.
+
In order to circumvent some of the inconsistencies and incompatibilities, there was need for a solution without tempering with the RTL and/or default support units.
  
−
So, i invented unit trinity which solves some of the encountered issues (the unit itself is a work in progress). Whether or not it is the right solution to solve things, i don't know. But, i also don't care as things simply needed to be compiled *period*.
+
That's were unit trinity comes into play, which solves some of the encountered issues (the unit itself is a work in progress). It provides the user with a way to solve things and let sources compile without too much hassle/workarounds.
  
−
Without further ado: Unit Trinity
+
The latest version of unit trinity is kindly provided by Magorium and can be found [https://github.com/magorium/fpc-triforce/tree/master/Base/Trinity here].
−
 
 
−
<source lang="pascal">
 
−
unit trinity;
 
−
 
 
−
 
 
−
// ---------------------------------------------------------------------------
 
−
// Edit Date  $ Entry
 
−
// ---------------------------------------------------------------------------
 
−
// 2015-08-22  $ CoerceMethod()
 
−
//            $ GetAttr()
 
−
// 2015-08-21  $ SetAndTest Longint version
 
−
// 2015-08-11  $ SetAttrs()
 
−
//            $ additional TAG_() functions for Amiga
 
−
//            $ additional TAG_() functions for MorphOS
 
−
//            $ array of const for Amiga's DoMethod() instead of LW's
 
−
//            $ workaround "Conversion between ordinals and pointers
 
−
//              is not portable" hint messages
 
−
//            $ Useful MUI text macro's
 
−
// 2015-08-06  $ initial release
 
−
// ---------------------------------------------------------------------------
 
−
 
 
−
 
 
−
{$IFNDEF HASAMIGA}
 
−
{$FATAL This source is compatible with Amiga, AROS and MorphOS only !}
 
−
{$ENDIF}
 
−
 
 
−
 
 
−
{$MODE OBJFPC}{$H+}
 
−
 
 
−
 
 
−
interface
 
−
 
 
−
 
 
−
Uses
 
−
  Exec, Intuition, Utility;
 
−
 
 
−
 
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
//
 
−
//  Topic: Some generic c-helpers, should not be in here at all but convienent
 
−
//
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
 
 
−
 
 
−
 
 
−
  function  SetAndTest(Var OldValue: pointer;  NewValue: pointer) : boolean; overload; inline;
 
−
  function  SetAndTest(Var OldValue: LongWord; NewValue: LongWord): boolean; overload; inline;
 
−
  function  SetAndTest(Var OldValue: LongInt;  NewValue: LongInt) : boolean; overload; inline;
 
−
 
 
−
 
 
−
 
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
//
 
−
//  Topic: Hooks -> cross-platform support
 
−
//
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
 
 
−
 
 
−
 
 
−
Type
 
−
  // THookFunction = function(Hook: pHook; obj: PObject_; Msg: Pointer): LongWord;
 
−
  THookFunction = function(Hook: pHook; obj: APTR; Msg: APTR): LongWord;
 
−
 
 
−
  Procedure InitHook(Var Hook: THook; Func: THookFunction; Data: APTR);
 
−
 
 
−
 
 
−
 
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
//
 
−
//  Topic: Tags and TagValue's. Array of const = LongInt vs. Array of long
 
−
//        Cosmetic only e.g. get rid of compiler warnings
 
−
//
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
 
 
−
 
 
−
 
 
−
  {$IFDEF AROS}
 
−
  Function TAG_(TagItem: LongWord): LongInt; overload; inline;
 
−
  //Function TAG_(TagItem: LongInt ): LongInt; overload; inline;
 
−
  Function  TAG_(TagItem: Pointer ): LongInt; overload; inline;
 
−
  function  TAG_(TagItem: boolean ): LongInt; overload; inline;
 
−
  {$ENDIF}
 
−
  {$IFDEF AMIGA}
 
−
  Function  TAG_(TagItem: LongWord): LongInt; overload; inline;
 
−
  //Function TAG_(TagItem: LongInt ): LongInt; overload; inline;
 
−
  Function  TAG_(TagItem: Pointer ): LongInt; overload; inline;
 
−
  function  TAG_(TagItem: boolean ): LongInt; overload; inline;
 
−
  {$ENDIF}
 
−
  {$IFDEF MORPHOS}
 
−
  //Function TAG_(TagItem: LongWord): LongWord; overload; inline;
 
−
  Function  TAG_(TagItem: LongInt ): LongWord; overload; inline;
 
−
  Function  TAG_(TagItem: Pointer ): LongWord; overload; inline;
 
−
  function  TAG_(TagItem: boolean ): LongWord; overload; inline; 
 
−
  {$ENDIF}
 
−
 
 
−
 
 
−
 
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
//
 
−
//  Topic: SetGadgetAttrs(), missing from MorphOS
 
−
//
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
 
 
−
 
 
−
 
 
−
  {$IFDEF MORPHOS}
 
−
  function  SetGadgetAttrs(Gadget: PGadget; Window: PWindow; Requester: PRequester; const Tags: array of long): ULONG;
 
−
  {$ENDIF}
 
−
 
 
−
 
 
−
 
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
//
 
−
//  Topic: DoMethod()
 
−
//        Amiga  : Missing
 
−
//        MorphOS : wrong parameter declaration
 
−
//        ALL    : missing none msg version
 
−
//
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
 
 
−
 
 
−
 
 
−
  function  DoMethod(obj : pointer; MethodID: ULONG): ULONG; overload;
 
−
  {$IFDEF AMIGA}
 
−
  function  DoMethod(obj : pointer; MethodID: ULONG; const msg : array of const): ULONG; overload;
 
−
  {$ENDIF}
 
−
  {$IFDEF MORPHOS}
 
−
  function  DoMethod(obj : pointer; MethodID: ULONG; const msg : array of ULONG): ULONG; overload;
 
−
  {$ENDIF}
 
−
 
 
−
 
 
−
 
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
//
 
−
//  Topic: DoSuperMethod()
 
−
//        Amiga          : Missing
 
−
//        MorphOS + AROS : wrong parameter declaration
 
−
//        ALL            : missing none msg version
 
−
//
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
 
 
−
 
 
−
 
 
−
  function  DoSuperMethod(cl: pointer; obj : pointer; id: LongWord): LongWord; overload;
 
−
  {$IF DEFINED(AMIGA) or DEFINED(MORPHOS) or DEFINED(AROS)}
 
−
  function  DoSuperMethod(cl: pointer; obj : pointer; id: LongWord; const msg : array of LongWord): longword; overload;
 
−
  {$ENDIF}
 
−
 
 
−
 
 
−
 
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
//
 
−
//  Topic: Structure TWBArg, Missing from MorphOS because of lacking unit
 
−
//        Workbench
 
−
//
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
 
 
−
 
 
−
 
 
−
{$IFDEF MORPHOS}
 
−
Type
 
−
  PWBArg = ^TWBArg;
 
−
  TWBArg = Record
 
−
    wa_lock: BPTR;  //* a lock descriptor */
 
−
    wa_Name: PChar;  //* a string relative to that lock */
 
−
  end;
 
−
{$ENDIF}
 
−
 
 
−
 
 
−
 
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
//
 
−
//  Topic: Function SetAttrs(), this varargs version missing from Amiga & MOS
 
−
//
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
 
 
−
 
 
−
 
 
−
  {$IFDEF AMIGA}
 
−
  function  SetAttrs(Obj: APTR; tagList: Array of Const): ULONG;
 
−
  {$ENDIF}
 
−
  {$IFDEF MORPHOS}
 
−
  function  SetAttrs(Obj: APTR; tagList: Array of DWord): ULONG;
 
−
  {$ENDIF}
 
−
 
 
−
 
 
−
 
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
//
 
−
//  Topic:  Useful MUI text macro's. Used other names to avoid conflicts.
 
−
//
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
 
 
−
 
 
−
 
 
−
const
 
−
  Esc_R            = #27#114;  //  right justified
 
−
  Esc_C            = #27#099;  //  centered
 
−
  Esc_L            = #27#108;  //  left justified
 
−
  Esc_N            = #27#110;  //  normal
 
−
  Esc_B            = #27#098;  //  bold
 
−
  Esc_I            = #27#105;  //  italic
 
−
  Esc_U            = #27#117;  //  underlined
 
−
  Esc_PT            = #27#050;  //  text pen
 
−
  Esc_PH            = #27#056;  //  highlight text pen
 
−
 
 
−
  // Specials
 
−
  Esc_IMS          = #27#073;  //  Standard MUI Image
 
−
  Esc_IMC          = #27#079;  //  Created MUI Image
 
−
 
 
−
 
 
−
 
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
//
 
−
//  Topic: CoerceMethos()
 
−
//
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
 
 
−
 
 
−
 
 
−
{$IFDEF MORPHOS}
 
−
Type
 
−
  PBoopsiObject = PObject_;
 
−
{$ENDIF}
 
−
 
 
−
  {$IFDEF AMIGA}
 
−
  function  CoerceMethod(cl: PIClass; Obj: PObject_; MethodID: ULONG): ULONG;
 
−
  function  CoerceMethod(cl: PIClass; Obj: PObject_; MethodID: ULONG; const Msg: array of const): ULONG; overload;
 
−
  {$ENDIF}
 
−
  {$IFDEF AROS}
 
−
  function  CoerceMethod(cl: PIClass; Obj: PObject_; MethodID: IPTR): IPTR;
 
−
  {$ENDIF}
 
−
  {$IFDEF MORPHOS}
 
−
  function  CoerceMethodA(cl: PIClass; Obj: PObject_; Msg: Pointer): ULONG;
 
−
  function  CoerceMethod(cl: PIClass; Obj: PBoopsiobject; MethodID: ULONG): ULONG;
 
−
  function  CoerceMethod(cl: PIClass; Obj: PBoopsiObject; MethodID: ULONG; const Msg: array of ULONG): ULONG;
 
−
  {$ENDIF}
 
−
 
 
−
 
 
−
 
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
//
 
−
//  Topic: GetAttr() for Morphos, complying to autodocs.
 
−
//
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
 
 
−
 
 
−
 
 
−
  {$IFDEF MORPHOS}
 
−
  function GetAttr(attrID : CARDINAL location 'd0'; object1 : POINTER location 'a0'; storagePtr : PCARDINAL location 'a1') : CARDINAL; SysCall IntuitionBase 654; 
 
−
  {$ENDIF}
 
−
 
 
−
 
 
−
 
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
//
 
−
//  Topic:
 
−
//
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
 
 
−
 
 
−
 
 
−
implementation
 
−
 
 
−
 
 
−
{$IFDEF AMIGA}
 
−
Uses
 
−
  AmigaLib, tagsarray;
 
−
{$ENDIF}
 
−
 
 
−
{$IFDEF MORPHOS}
 
−
Uses
 
−
  AmigaLib;
 
−
{$ENDIF}
 
−
 
 
−
 
 
−
 
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
//
 
−
//  Topic: Some generic c-helpers, should not be in here
 
−
//
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
 
 
−
 
 
−
 
 
−
function  SetAndTest(Var OldValue: pointer; NewValue: pointer): boolean;
 
−
begin
 
−
  OldValue := NewValue;
 
−
  result := (NewValue <> nil)
 
−
end;
 
−
 
 
−
function  SetAndTest(Var OldValue: LongWord; NewValue: LongWord): boolean;
 
−
begin
 
−
  OldValue := NewValue;
 
−
  result := (NewValue <> 0)
 
−
end;
 
−
 
 
−
function  SetAndTest(Var OldValue: LongInt; NewValue: LongInt): boolean;
 
−
begin
 
−
  OldValue := NewValue;
 
−
  result := (NewValue <> 0)
 
−
end;
 
−
 
 
−
 
 
−
 
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
//
 
−
//  Topic: Hooks
 
−
//
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
 
 
−
 
 
−
 
 
−
{$IFDEF CPU68}
 
−
procedure InitHook(var Hook: THook; Func: THookFunction; Data: APTR);
 
−
begin
 
−
  Hook.h_Entry    := @HookEntry;
 
−
  Hook.h_SubEntry := Func;
 
−
  Hook.h_Data    := Data;
 
−
end;
 
−
{$ENDIF}
 
−
 
 
−
 
 
−
 
 
−
{$IFDEF CPU86}
 
−
function  _hookEntry(h: PHook; obj: PObject_; Msg: Pointer): LongWord; cdecl;
 
−
var
 
−
  Func: THookFunction;
 
−
begin
 
−
  {$PUSH}{$HINTS OFF}
 
−
  Func  := THookFunction(h^.h_SubEntry);
 
−
  {$POP}
 
−
  result := Func(h, obj, msg);
 
−
end;
 
−
 
 
−
procedure InitHook(var Hook: THook; Func: THookFunction; Data: APTR);
 
−
begin
 
−
  {$PUSH}{$HINTS OFF}
 
−
  Hook.h_Entry    := IPTR(@_hookEntry);
 
−
  Hook.h_SubEntry := IPTR(Func);
 
−
  {$POP}
 
−
  Hook.h_Data    := Data;
 
−
end;
 
−
{$ENDIF}
 
−
 
 
−
 
 
−
 
 
−
{$IFDEF CPUPOWERPC}
 
−
procedure InitHook(var Hook: THook; Func: THookFunction; Data: APTR);
 
−
const
 
−
  HOOKENTRY_TRAP: TEmulLibEntry = ( Trap: TRAP_LIB; Extension: 0; Func: @HookEntry );
 
−
begin
 
−
  Hook.h_Entry    := @HOOKENTRY_TRAP;
 
−
  Hook.h_SubEntry := Func;
 
−
  Hook.h_Data    := Data;
 
−
end;
 
−
{$ENDIF}
 
−
 
 
−
 
 
−
 
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
//
 
−
//  Topic: Tags
 
−
//
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
 
 
−
 
 
−
 
 
−
{$IFDEF AROS}
 
−
Function  TAG_(TagItem: LongWord): LongInt; inline;
 
−
begin
 
−
  Result := LongInt(TagItem);
 
−
end;
 
−
 
 
−
Function  TAG_(TagItem: LongInt): LongInt; inline;
 
−
begin
 
−
  Result := LongInt(TagItem);
 
−
end;
 
−
 
 
−
Function  TAG_(TagItem: Pointer): LongInt; inline;
 
−
begin
 
−
  {$PUSH}{$HINTS OFF}
 
−
  Result := LongInt(TagItem);
 
−
  {$POP}
 
−
end;
 
−
 
 
−
function  TAG_(TagItem: boolean): LongInt; inline;
 
−
begin
 
−
  Result := Ord(TagItem);
 
−
end;
 
−
{$ENDIF}
 
−
 
 
−
 
 
−
 
 
−
{$IFDEF AMIGA}
 
−
Function  TAG_(TagItem: LongWord): LongInt; inline;
 
−
begin
 
−
  Result := LongInt(TagItem);
 
−
end;
 
−
 
 
−
Function  TAG_(TagItem: LongInt): LongInt; inline;
 
−
begin
 
−
  Result := LongInt(TagItem);
 
−
end;
 
−
 
 
−
Function  TAG_(TagItem: Pointer): LongInt; inline;
 
−
begin
 
−
  {$PUSH}{$HINTS OFF}
 
−
  Result := LongInt(TagItem);
 
−
  {$POP}
 
−
end;
 
−
 
 
−
function  TAG_(TagItem: boolean): LongInt; inline;
 
−
begin
 
−
  Result := Ord(TagItem);
 
−
end;
 
−
{$ENDIF}
 
−
 
 
−
 
 
−
 
 
−
{$IFDEF MORPHOS}
 
−
Function  TAG_(TagItem: LongInt): LongWord; inline;
 
−
begin
 
−
  Result := LongWord(TagItem);
 
−
end;
 
−
 
 
−
Function  TAG_(TagItem: LongWord): LongWord; inline;
 
−
begin
 
−
  Result := LongWord(TagItem);
 
−
end;
 
−
 
 
−
Function  TAG_(TagItem: Pointer): LongWord; inline;
 
−
begin
 
−
  {$PUSH}{$HINTS OFF}
 
−
  Result := LongWord(TagItem);
 
−
  {$POP}
 
−
end;
 
−
 
 
−
function  TAG_(TagItem: boolean): LongWord; inline;
 
−
begin
 
−
  Result := Ord(TagItem);
 
−
end;
 
−
{$ENDIF}
 
−
 
 
−
 
 
−
 
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
//
 
−
//  Topic: SetGadgetAttrs(), missing from MorphOS
 
−
//
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
 
 
−
 
 
−
 
 
−
{$IFDEF MORPHOS}
 
−
function  SetGadgetAttrs(Gadget: PGadget; Window: PWindow; Requester: PRequester; const Tags: array of long): ULONG;
 
−
begin
 
−
  result := SetGadgetAttrsA(Gadget, Window, Requester, @Tags[0]);
 
−
end;
 
−
{$ENDIF}
 
−
 
 
−
 
 
−
 
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
//
 
−
//  Topic: DoMethod()
 
−
//
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
 
 
−
 
 
−
 
 
−
function  DoMethod(obj : pointer; MethodID: ULONG): ULONG;
 
−
Var
 
−
  Tags : Array[0..0] of ULONG;
 
−
begin
 
−
  Tags[0] := MethodID;
 
−
  Result := CALLHOOKPKT(PHook(OCLASS(obj)), obj, @(Tags[0]));
 
−
// or should it be: CALLHOOKPKT(PHook(OCLASS(Obj)), Obj, nil);
 
−
end;
 
−
 
 
−
{$IFDEF AMIGA}
 
−
operator := (Src: TVarRec) Dest: LongWord;
 
−
begin
 
−
  Case Src.vtype of
 
−
    {$PUSH}{$HINTS OFF}
 
−
    vtinteger  : Dest := PtrInt(Src.vinteger);
 
−
    vtboolean  : Dest := PtrInt(Src.vboolean);
 
−
    vtpchar    : Dest := PtrInt(Src.vpchar);
 
−
    vtchar    : Dest := PtrInt(Src.vchar);
 
−
    vtstring  : Dest := PtrInt(PChar(string(Src.vstring^)));
 
−
    vtpointer  : Dest := PtrInt(Src.vpointer);
 
−
    {$POP}
 
−
  end;
 
−
end;
 
−
 
 
−
function  DoMethod(obj : pointer; MethodID: ULONG; const msg : array of const): ULONG; overload;
 
−
Var
 
−
  Tags : Array of LongWord; i,n: integer;
 
−
begin
 
−
  SetLength(Tags, Length(msg) + 1);
 
−
 
 
−
  i := 0;
 
−
  Tags[i] := MethodID;
 
−
 
 
−
  for n := low(msg) to high(msg) do
 
−
  begin
 
−
    inc(i); 
 
−
    Tags[i] := msg[n];  // See operator
 
−
  end;
 
−
 
 
−
  Result := CALLHOOKPKT(PHook(OCLASS(Obj)), Obj, @(Tags[0]));
 
−
 
 
−
  SetLength(Tags, 0);
 
−
end;
 
−
{$ENDIF}
 
−
 
 
−
{$IFDEF MORPHOS}
 
−
function  DoMethod(obj : pointer; MethodID: ULONG; const msg : array of ULONG): ULONG; overload;
 
−
Var
 
−
  Tags : Array of LongWord; i,n: integer;
 
−
begin
 
−
  SetLength(Tags, Length(msg) + 1);
 
−
 
 
−
  i := 0;
 
−
  Tags[i] := MethodID;
 
−
 
 
−
  for n := low(msg) to high(msg) do
 
−
  begin
 
−
    inc(i);
 
−
    Tags[i] := msg[n];
 
−
  end;
 
−
 
 
−
  Result := CALLHOOKPKT(PHook(OCLASS(Obj)), Obj, @(Tags[0]));
 
−
  SetLength(Tags, 0);
 
−
end;
 
−
{$ENDIF}
 
−
 
 
−
 
 
−
 
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
//
 
−
//  Topic: DoSuperMethod()
 
−
//        Amiga          : Missing
 
−
//        MorphOS + AROS : wrong parameter declaration
 
−
//        ALL            : missing none msg version
 
−
//
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
 
 
−
 
 
−
 
 
−
function  DoSuperMethod(cl: pointer; obj : pointer; id: LongWord): LongWord; overload;
 
−
Var
 
−
  Tags : Array[0..0] of LongWord;
 
−
begin
 
−
  Tags[0] := id;
 
−
  Result  := DoSuperMethodA(cl, obj, @tags[0]);
 
−
  // or should it be: DoSuperMethodA(cl, obj, nil);
 
−
end;
 
−
 
 
−
 
 
−
 
 
−
{$IF DEFINED(AMIGA) or DEFINED(MORPHOS) or DEFINED(AROS)}
 
−
function  DoSuperMethod(cl: pointer; obj : pointer; id: LongWord; const msg : array of LongWord): longword; overload;
 
−
Var
 
−
  Tags : Array of LongWord; i,n: integer;
 
−
begin
 
−
  SetLength(Tags, Length(msg) + 1);
 
−
 
 
−
  i := 0;
 
−
  Tags[i] := id;
 
−
 
 
−
  for n := low(msg) to high(msg) do
 
−
  begin
 
−
    inc(i);
 
−
    Tags[i] := msg[n];
 
−
  end;
 
−
 
 
−
  Result := DoSuperMethodA(cl, obj, @tags[0]);
 
−
  SetLength(Tags, 0);
 
−
end;
 
−
{$ENDIF}
 
−
 
 
−
 
 
−
 
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
//
 
−
//  Topic: SetAttrs()
 
−
//
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
 
 
−
 
 
−
 
 
−
{$IFDEF AMIGA}
 
−
function  SetAttrs(Obj: APTR; tagList: Array of Const): ULONG;
 
−
begin
 
−
  Result := SetAttrsA(Obj, ReadInTags(tagList));
 
−
end;
 
−
{$ENDIF}
 
−
 
 
−
{$IFDEF MORPHOS}
 
−
function  SetAttrs(Obj: APTR; tagList: Array of DWord): ULONG;
 
−
begin
 
−
  Result := SetAttrsA(Obj, @tagList);
 
−
end;
 
−
{$ENDIF}
 
−
 
 
−
 
 
−
 
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
//
 
−
//  Topic: CoerceMethod()
 
−
//
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
 
 
−
 
 
−
 
 
−
{$IFDEF MORPHOS}
 
−
{$WARNING MORPHOS implementation of CoerceMethodA() is untested}
 
−
function  CoerceMethodA(cl: PIClass; Obj: PObject_; Msg: Pointer): ULONG;
 
−
begin
 
−
  If  ( (cl <> nil) and (Obj <> nil) )
 
−
  then result := CALLHOOKPKT(PHook(cl), obj, Msg)
 
−
  else result := 0;
 
−
end;
 
−
{$ENDIF}
 
−
 
 
−
{$IFDEF AMIGA}
 
−
function  CoerceMethod(cl: PIClass; Obj: PObject_; MethodID: ULONG): ULONG;
 
−
{$ENDIF}
 
−
{$IFDEF AROS}
 
−
function  CoerceMethod(cl: PIClass; Obj: PObject_; MethodID: IPTR): IPTR;
 
−
{$ENDIF}
 
−
{$IFDEF MORPHOS}
 
−
function  CoerceMethod(cl: PIClass; Obj: PBoopsiobject; MethodID: ULONG): ULONG;
 
−
{$ENDIF}
 
−
Var
 
−
  Tags : Array[0..0] of ULONG;
 
−
begin
 
−
  {$IFDEF AROS}
 
−
  if ( not(obj <> nil) or not (cl <> nil) ) then exit(0);
 
−
  {$ENDIF}
 
−
  Tags[0] := MethodID;
 
−
  Result := CoerceMethodA(cl, Obj, @(Tags[0]));
 
−
end;
 
−
 
 
−
{$IFDEF AMIGA}
 
−
function  CoerceMethod(cl: PIClass; Obj: PObject_; MethodID: ULONG; const Msg: array of const): ULONG; overload;
 
−
Var
 
−
  Tags : Array of LongWord; i,n: integer;
 
−
begin
 
−
  SetLength(Tags, Length(Msg) + 1);
 
−
 
 
−
  i := 0;
 
−
  Tags[i] := MethodID;
 
−
 
 
−
  for n := low(Msg) to high(Msg) do
 
−
  begin
 
−
    inc(i); 
 
−
    Tags[i] := Msg[n];  // See operator
 
−
  end;
 
−
 
 
−
  Result := CoerceMethodA(cl, Obj, @(Tags[0]));
 
−
 
 
−
  SetLength(Tags, 0);
 
−
end;
 
−
{$ENDIF}
 
−
 
 
−
{$IFDEF MORPHOS}
 
−
function  CoerceMethod(cl: PIClass; Obj: PBoopsiObject; MethodID: ULONG; const Msg: array of ULONG): ULONG;
 
−
Var
 
−
  Tags : Array of LongWord; i,n: integer;
 
−
begin
 
−
  SetLength(Tags, Length(Msg) + 1);
 
−
 
 
−
  i := 0;
 
−
  Tags[i] := MethodID;
 
−
 
 
−
  for n := low(Msg) to high(Msg) do
 
−
  begin
 
−
    inc(i);
 
−
    Tags[i] := Msg[n];
 
−
  end;
 
−
 
 
−
  Result := CoerceMethodA(cl, Obj, @(Tags[0]));
 
−
 
 
−
  SetLength(Tags, 0);
 
−
end;
 
−
{$ENDIF}
 
−
 
 
−
 
 
−
 
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
//
 
−
//  Topic:
 
−
//
 
−
//////////////////////////////////////////////////////////////////////////////
 
−
 
 
−
 
 
−
end.
 
−
</source>
 

Revision as of 14:25, 30 August 2015

Note

Based on Free Pascal branch "fixes 3.0"

Feel free to add delete or change status.

Our trinity consist of Amiga, AROS and MorphOS.

Unfortunately, there are (still) some incompatibilities and/or some lack of consistency here and there. The idea is to have a list here that mentions them all. Layout may change, i simply had to start somewhere.

NOTE: I thought there is no use to mention the Tag, Tags, Taglist, etc. inconsistency and additional incompatibilities that this causes. We are all aware of those and will hopefully get some unity in the future


List of issues

  • function: DoMethod()
Amiga version seems missing completely.
Implemented versions for AROS and MorphOS don't follow autodocs 100% and are inconsistent.
  • function: ASLRequestTags()
AROS implementation seems missing.
Amiga implements it in utility unit systemvartags (see also unit: systemvartags)
MorphOS implements it in unit ASL
  • structure: Hook
AROS version, entries are not IPTR rather APTR.
  • function: GetAttr()
MorphOS uses a var for parameter Return-Value while Amiga + AROS uses a pointer. Autodocs states it to be a pointer.
  • function: SetAttrs()
Amiga + MorphOS implementations seems missing
  • unit: Workbench
MorphOS version seems missing
  • unit: systemvartags
This utility unit is Amiga specific and implements most if not all vartags versions of library-calls rendering it incompatible with AROS and MorphOS
  • function: AllocMem() (high priority)
MorphOS implemented it as ExecAllocMem
Amiga + AROS version have this function declared as AllocMem(), which is ambiguous with Free Pascal's AllocMem function.
  • function: Info()
AutoDocs: BOOL = Info( BPTR, struct InfoData * )
Amiga declaration: FUNCTION Info(lock : LONGINT location 'd1'; parameterBlock : pInfoData location 'd2') : LongBool; syscall _DOSBase 114;
AROS declaration: function Info(Lock: BPTR; ParameterBlock: PInfoData): LongInt; syscall AOS_DOSBase 19;
MorphOS declaration: function Info(lock : LongInt location 'd1'; parameterBlock: PInfoData location 'd2'): LongInt; SysCall MOS_DOSBase 114;
  • function: VFPrintf()
AutoDocs: LONG = VFPrintf(BPTR, STRPTR, LONG *)
Amiga declaration: FUNCTION VFPrintf(fh : LONGINT location 'd1';const format : pCHAR location 'd2';const argarray : POINTER location 'd3') : LONGINT; syscall _DOSBase 354;
AROS declaration: function VFPrintf(Fh: BPTR; const format: STRPTR; const ArgArray: PLongInt): LongInt; syscall AOS_DOSBase 59;
MorphOS declaration: function VFPrintf(fh : LongInt location 'd1'; format: PChar location 'd2'; argarray: Pointer location 'd3'): LongInt; SysCall MOS_DOSBase 354;
NOTE: the generic pointer declaration prevents using "VFPrintf(nil/0, 'text', vargs );" where vargs = array of long.
Remark: AFAIK for AROS it is theoretically possible to pass 64-bit formatted values.
  • function: AslRequest()
autodocs: BOOL AslRequest( APTR,struct TagItem * );
Amiga: FUNCTION AslRequest(requester : POINTER location 'a0'; tagList : pTagItem location 'a1') : LongInt; syscall AslBase 060;
AROS: function AslRequest(Requester: Pointer; const Tags: array of const): LongBool;
MorphOS: function AslRequest(requester: Pointer location 'a0'; tagList : pTagItem location 'a1'): LongBool; SysCall AslBase 060;
  • function: SetGadgetAttrs()
MorphOS version seems missing
  • Constants: MUIX_R, MUIX_C, MUIX_L, MUIX_N, MUIX_B, MUIX_I, MUIX_U, MUIX_PT and MUIX_PH
AMIGA + AROS: these MUI constants uses c-language escape code characters, which won't work for Free Pascal.
MorphOS: declared them as they should.
  • function: NextTagItem()
autodocs: struct TagItem *NextTagItem(struct TagItem **);
Amiga: function NextTagItem(Item : ppTagItem location 'a0') : pTagItem; syscall _UtilityBase 048;
AROS: function NextTagItem(var Item: PTagItem): PTagItem; syscall AOS_UtilityBase 8;
MorphOS: function NextTagItem(tagListPtr: pPTagItem location 'a0'): PTagItem; SysCall MOS_UtilityBase 048;
  • function: WriteStr()
On MorphOS this function seems declared as Amiga-function, which clashes with Free Pascal build-in function WriteStr. Strange as WriteStr seems only declared as dos/stdio.h macro.
  • function: CoerceMethod()
MorphOS version seems missing completely (including CoerceMethodA().
Amiga version has CoerceMethodA() implemented but no CoerceMethod()
Implemented versions for AROS and Amiga don't follow autodocs 100% and are inconsistent.
  • type: Tag
Utility: "typedef ULONG Tag;"
AmigaOS: "Type Tag = LongInt;"
  • record field: ti_Data of record tTagItem
Utility: "ULONG ti_Data;"
Amiga: "ti_Data : LongInt;"
  • type: PPObject_
Missing for Amiga and MorphOS

Some of your finest

  • AslRequest()
 {$IFDEF AMIGA}
 if (AslRequest(fr, nil) <> 0) then
 {$ENDIF}
 {$IFDEF AROS}
 if (AslRequestA(fr, nil)) then
 {$ENDIF}
 {$IFDEF MORPHOS}
 if (AslRequest(fr, nil)) then
 {$ENDIF}
 begin
  // Could we now please check what the requester returned ?
 end;


Hardening trinity

In order to circumvent some of the inconsistencies and incompatibilities, there was need for a solution without tempering with the RTL and/or default support units.

That's were unit trinity comes into play, which solves some of the encountered issues (the unit itself is a work in progress). It provides the user with a way to solve things and let sources compile without too much hassle/workarounds.

The latest version of unit trinity is kindly provided by Magorium and can be found here.