paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-04 18:30:36 +02:00
Code Issues Packages Projects Releases Wiki Activity

Amiga, AROS, MorphOS: TAG_(), AsTag() for easer varargs handling

Browse Source 
git-svn-id: trunk@33223 -
This commit is contained in:
marcus 2016-03-12 13:50:00 +00:00
parent 1e792e6f06
commit 759170f822
3 changed files with 155 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
packages/amunits/src/coreunits/utility.pas
View File

@ -391,6 +391,16 @@ FUNCTION Strnicmp(CONST string1 : pCHAR; CONST string2 : string; length : LONGIN
FUNCTION Strnicmp(CONST string1 : string; CONST string2 : string; length : LONGINT) : LONGINT; FUNCTION Strnicmp(CONST string1 : string; CONST string2 : string; length : LONGINT) : LONGINT;
function TAG_(value: pointer): PtrUInt; overload; inline;
function TAG_(value: pchar): PtrUInt; overload; inline;
function TAG_(value: boolean): PtrUInt; overload; inline;
function TAG_(value: integer): PtrUInt; overload; inline;
function AsTag(value: pointer): PtrUInt; overload; inline;
function AsTag(value: pchar): PtrUInt; overload; inline;
function AsTag(value: boolean): PtrUInt; overload; inline;
function AsTag(value: integer): PtrUInt; overload; inline;
IMPLEMENTATION IMPLEMENTATION
function AllocNamedObject(name : STRPTR; Const argv : array of PtrUInt) : pNamedObject; function AllocNamedObject(name : STRPTR; Const argv : array of PtrUInt) : pNamedObject;
@ -439,6 +449,52 @@ begin
Strnicmp := Strnicmp(PChar(RawbyteString(string1)),PChar(RawbyteString(string2)),length); Strnicmp := Strnicmp(PChar(RawbyteString(string1)),PChar(RawbyteString(string2)),length);
end; end;
function TAG_(value: pointer): PtrUInt; inline;
begin
TAG_:=PtrUInt(value);
end;
function TAG_(value: pchar): PtrUInt; inline;
begin
TAG_:=PtrUInt(value);
end;
function TAG_(value: boolean): PtrUInt; inline;
begin
if value then
TAG_ := LTrue
else
TAG_ := LFalse;
end;
function TAG_(value: integer): PtrUInt; inline;
begin
TAG_:=PtrUInt(value);
end;
function AsTag(value: pointer): PtrUInt; inline;
begin
AsTag:=PtrUInt(value);
end;
function AsTag(value: pchar): PtrUInt; inline;
begin
AsTag:=PtrUInt(value);
end;
function AsTag(value: boolean): PtrUInt; inline;
begin
if value then
AsTag := LTrue
else
AsTag := LFalse;
end;
function AsTag(value: integer): PtrUInt; inline;
begin
AsTag:=PtrUInt(value);
end;
initialization initialization
UtilityBase := _UtilityBase; UtilityBase := _UtilityBase;
end. end.

56
packages/arosunits/src/utility.pas
View File

@ -255,6 +255,16 @@ function CALLHOOKPKT_(Hook: PHook; Object_: APTR; Message: APTR): IPTR; inline;
function AllocNamedObject(const Name: STRPTR; const Tags: array of PtrUInt): PNamedObject; function AllocNamedObject(const Name: STRPTR; const Tags: array of PtrUInt): PNamedObject;
function CallHook(Hook: PHook; Object_: APTR; const Params: array of PtrUInt): IPTR; function CallHook(Hook: PHook; Object_: APTR; const Params: array of PtrUInt): IPTR;
function TAG_(Value: Pointer): PtrUInt; overload; inline;
function TAG_(Value: PChar): PtrUInt; overload; inline;
function TAG_(Value: boolean): PtrUInt; overload; inline;
function TAG_(Value: integer): PtrUInt; overload; inline;
function AsTag(Value: Pointer): PtrUInt; overload; inline;
function AsTag(Value: PChar): PtrUInt; overload; inline;
function AsTag(Value: boolean): PtrUInt; overload; inline;
function AsTag(Value: integer): PtrUInt; overload; inline;
implementation implementation
function AllocNamedObject(const Name: STRPTR; const Tags: array of PtrUInt): PNamedObject; inline; function AllocNamedObject(const Name: STRPTR; const Tags: array of PtrUInt): PNamedObject; inline;
@ -280,4 +290,50 @@ begin
CALLHOOKPKT_ := FuncPtr(Hook, Object_, Message); CALLHOOKPKT_ := FuncPtr(Hook, Object_, Message);
end; end;
function TAG_(Value: pointer): PtrUInt; inline;
begin
TAG_ := PtrUInt(Value);
end;
function TAG_(value: pchar): PtrUInt; inline;
begin
TAG_ := PtrUInt(Value);
end;
function TAG_(value: boolean): PtrUInt; inline;
begin
if Value then
TAG_ := LTrue
else
TAG_ := LFalse;
end;
function TAG_(Value: Integer): PtrUInt; inline;
begin
TAG_ := PtrUInt(Value);
end;
function AsTag(Value: pointer): PtrUInt; inline;
begin
AsTag := PtrUInt(Value);
end;
function AsTag(value: pchar): PtrUInt; inline;
begin
AsTag := PtrUInt(Value);
end;
function AsTag(value: boolean): PtrUInt; inline;
begin
if Value then
AsTag := LTrue
else
AsTag := LFalse;
end;
function AsTag(Value: Integer): PtrUInt; inline;
begin
AsTag := PtrUInt(Value);
end;
end. end.

45
packages/morphunits/src/utility.pas
View File

@ -347,9 +347,15 @@ function GetUniqueID: Cardinal;
SysCall MOS_UtilityBase 270; SysCall MOS_UtilityBase 270;
function TAG_(value: pointer): longword; inline; function TAG_(value: pointer): longword; overload; inline;
function TAG_(value: pchar): longword; inline; function TAG_(value: pchar): longword; overload; inline;
function TAG_(value: boolean): longword; overload; inline;
function TAG_(value: integer): longword; overload; inline;
function AsTag(value: pointer): longword; overload; inline;
function AsTag(value: pchar): longword; overload; inline;
function AsTag(value: boolean): longword; overload; inline;
function AsTag(value: integer): longword; overload; inline;
implementation implementation
@ -363,6 +369,41 @@ begin
TAG_:=longword(value); TAG_:=longword(value);
end; end;
function TAG_(value: boolean): longword; inline;
begin
if value then
TAG_ := LTrue
else
TAG_ := LFalse;
end;
function TAG_(value: integer): longword; inline;
begin
TAG_:=longword(value);
end;
function AsTag(value: pointer): longword; inline;
begin
AsTag:=longword(value);
end;
function AsTag(value: pchar): longword; inline;
begin
AsTag:=longword(value);
end;
function AsTag(value: boolean): longword; inline;
begin
if value then
AsTag := LTrue
else
AsTag := LFalse;
end;
function AsTag(value: integer): longword; inline;
begin
AsTag:=longword(value);
end;
begin begin
UtilityBase:=MOS_UtilityBase; UtilityBase:=MOS_UtilityBase;