Trinity in Trouble

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()

Amiga + MorphOS uses a var for ReturnValue while 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

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, i needed a solution without tempering with the RTL and/or 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*.

Without further ado: Unit Trinity

unit trinity;


// Last Edit: 2015-08-06


{$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;



//////////////////////////////////////////////////////////////////////////////
//
//  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;
  {$ENDIF}
  {$IFDEF AMIGA}
  Function TAG_(TagItem: LongInt): LongInt; overload; inline;
  Function TAG_(TagItem: Pointer): LongInt; overload; inline;
  {$ENDIF}
  {$IFDEF MORPHOS}
  Function TAG_(TagItem: LongWord): LongWord; overload; inline;
  Function TAG_(TagItem: Pointer): 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; id: LongWord): LongWord; overload;
  {$IF DEFINED(AMIGA) or DEFINED(MORPHOS)}
  function DoMethod(obj : pointer; id: LongWord; const msg : array of LongWord): longword; 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: 
//
//////////////////////////////////////////////////////////////////////////////

//////////////////////////////////////////////////////////////////////////////
//
//  Topic: 
//
//////////////////////////////////////////////////////////////////////////////

//////////////////////////////////////////////////////////////////////////////
//
//  Topic: 
//
//////////////////////////////////////////////////////////////////////////////



implementation


{$IF DEFINED(AMIGA) or DEFINED(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;



//////////////////////////////////////////////////////////////////////////////
//
//  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
  Func   := THookFunction(h^.h_SubEntry);
  result := Func(h, obj, msg);
end;

procedure InitHook(var Hook: THook; Func: THookFunction; Data: APTR);
begin
  Hook.h_Entry    := IPTR(@_hookEntry);
  Hook.h_SubEntry := IPTR(Func);
  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
  Result := LongInt(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: LongInt): LongWord; inline;
begin
  Result := LongWord(TagItem);
end;
*)
Function TAG_(TagItem: Pointer): LongInt; inline;
begin
  Result := LongInt(TagItem);
end;
{$ENDIF}



{$IFDEF MORPHOS}
Function TAG_(TagItem: LongWord): LongWord; inline;
begin
  Result := LongWord(TagItem);
end;

Function TAG_(TagItem: Pointer): LongWord; inline;
begin
  Result := LongWord(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; id: LongWord): LongWord;
Var
  Tags : Array[0..0] of LongWord;
begin
  Tags[0] := id;
  Result := CALLHOOKPKT(PHook(OCLASS(Obj)), Obj, @(Tags[0]));
 // or should it be: CALLHOOKPKT(PHook(OCLASS(Obj)), Obj, nil);
end;



{$IF DEFINED(AMIGA) or DEFINED(MORPHOS)}
function DoMethod(obj : pointer; id: LongWord; const msg : array of LongWord): longword;
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 := 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: 
//
//////////////////////////////////////////////////////////////////////////////

//////////////////////////////////////////////////////////////////////////////
//
//  Topic: 
//
//////////////////////////////////////////////////////////////////////////////

//////////////////////////////////////////////////////////////////////////////
//
//  Topic: 
//
//////////////////////////////////////////////////////////////////////////////
end.

Trinity in Trouble

List of issues

Some of your finest

Hardening trinity

Navigation menu

Search